Merge branch 'master' into 'live'
Master Closes #179 See merge request !72
This commit is contained in:
Steffen Jost
commit
5c60f800fe
14
ChangeLog.md
14
ChangeLog.md
@ -1,4 +1,16 @@
|
|||||||
* Version 06.08.2016
|
* Version 18.09.2018
|
||||||
|
|
||||||
|
Tooltips funktionieren auch ohne JavaScript
|
||||||
|
|
||||||
|
Kurskürzel müssen nur innerhalb eines Instituts eindeutig sein
|
||||||
|
|
||||||
|
User Data zeigt nun alle momentan gespeicherten Datensätze an
|
||||||
|
|
||||||
|
Unterstützung von Tabellenzusammenfassungen, z.B. Punktsummen
|
||||||
|
|
||||||
|
Intelligente Verteilung von Abgaben auf Korrektoren (z.B. bei Krankheit)
|
||||||
|
|
||||||
|
* Version 06.08.2018
|
||||||
|
|
||||||
Einführung einer Option, ob Dateien automatisch heruntergeladen werden sollen
|
Einführung einer Option, ob Dateien automatisch heruntergeladen werden sollen
|
||||||
|
|
||||||
|
|||||||
18
db.hs
18
db.hs
@ -71,6 +71,7 @@ fillDb = do
|
|||||||
, userMatrikelnummer = Nothing
|
, userMatrikelnummer = Nothing
|
||||||
, userEmail = "G.Kleen@campus.lmu.de"
|
, userEmail = "G.Kleen@campus.lmu.de"
|
||||||
, userDisplayName = "Gregor Kleen"
|
, userDisplayName = "Gregor Kleen"
|
||||||
|
, userSurname = "Kleen"
|
||||||
, userMaxFavourites = 6
|
, userMaxFavourites = 6
|
||||||
, userTheme = ThemeDefault
|
, userTheme = ThemeDefault
|
||||||
, userDateTimeFormat = userDefaultDateTimeFormat
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||||
@ -84,6 +85,7 @@ fillDb = do
|
|||||||
, userMatrikelnummer = Nothing
|
, userMatrikelnummer = Nothing
|
||||||
, userEmail = "felix.hamann@campus.lmu.de"
|
, userEmail = "felix.hamann@campus.lmu.de"
|
||||||
, userDisplayName = "Felix Hamann"
|
, userDisplayName = "Felix Hamann"
|
||||||
|
, userSurname = "Hamann"
|
||||||
, userMaxFavourites = userDefaultMaxFavourites
|
, userMaxFavourites = userDefaultMaxFavourites
|
||||||
, userTheme = ThemeDefault
|
, userTheme = ThemeDefault
|
||||||
, userDateTimeFormat = userDefaultDateTimeFormat
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||||
@ -97,6 +99,7 @@ fillDb = do
|
|||||||
, userMatrikelnummer = Nothing
|
, userMatrikelnummer = Nothing
|
||||||
, userEmail = "jost@tcs.ifi.lmu.de"
|
, userEmail = "jost@tcs.ifi.lmu.de"
|
||||||
, userDisplayName = "Steffen Jost"
|
, userDisplayName = "Steffen Jost"
|
||||||
|
, userSurname = "Jost"
|
||||||
, userMaxFavourites = 14
|
, userMaxFavourites = 14
|
||||||
, userTheme = ThemeMossGreen
|
, userTheme = ThemeMossGreen
|
||||||
, userDateTimeFormat = userDefaultDateTimeFormat
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||||
@ -110,6 +113,7 @@ fillDb = do
|
|||||||
, userMatrikelnummer = Nothing
|
, userMatrikelnummer = Nothing
|
||||||
, userEmail = "max@campus.lmu.de"
|
, userEmail = "max@campus.lmu.de"
|
||||||
, userDisplayName = "Max Musterstudent"
|
, userDisplayName = "Max Musterstudent"
|
||||||
|
, userSurname = "Musterstudent"
|
||||||
, userMaxFavourites = 7
|
, userMaxFavourites = 7
|
||||||
, userTheme = ThemeAberdeenReds
|
, userTheme = ThemeAberdeenReds
|
||||||
, userDateTimeFormat = userDefaultDateTimeFormat
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||||
@ -117,6 +121,20 @@ fillDb = do
|
|||||||
, userTimeFormat = userDefaultTimeFormat
|
, userTimeFormat = userDefaultTimeFormat
|
||||||
, userDownloadFiles = userDefaultDownloadFiles
|
, userDownloadFiles = userDefaultDownloadFiles
|
||||||
}
|
}
|
||||||
|
void . insert $ User
|
||||||
|
{ userPlugin = "LDAP"
|
||||||
|
, userIdent = "tester@campus.lmu.de"
|
||||||
|
, userMatrikelnummer = Just "999"
|
||||||
|
, userEmail = "tester@campus.lmu.de"
|
||||||
|
, userDisplayName = "Tina Tester"
|
||||||
|
, userSurname = "von Terror"
|
||||||
|
, userMaxFavourites = 5
|
||||||
|
, userTheme = ThemeAberdeenReds
|
||||||
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||||
|
, userDateFormat = userDefaultDateFormat
|
||||||
|
, userTimeFormat = userDefaultTimeFormat
|
||||||
|
, userDownloadFiles = userDefaultDownloadFiles
|
||||||
|
}
|
||||||
void . insert $ Term
|
void . insert $ Term
|
||||||
{ termName = summer2017
|
{ termName = summer2017
|
||||||
, termStart = fromGregorian 2017 04 09
|
, termStart = fromGregorian 2017 04 09
|
||||||
|
|||||||
@ -27,6 +27,9 @@ InvalidInput: Eingaben bitte korrigieren.
|
|||||||
Term: Semester
|
Term: Semester
|
||||||
TermPlaceholder: W/S + vierstellige Jahreszahl
|
TermPlaceholder: W/S + vierstellige Jahreszahl
|
||||||
|
|
||||||
|
SchoolListHeading: Übersicht über verwaltete Institute
|
||||||
|
SchoolHeading school@SchoolName: Übersicht #{display school}
|
||||||
|
|
||||||
LectureStart: Beginn Vorlesungen
|
LectureStart: Beginn Vorlesungen
|
||||||
|
|
||||||
Course: Kurs
|
Course: Kurs
|
||||||
@ -72,15 +75,15 @@ CourseDeregisterUntilTip: Abmeldung darf auch ohne Begrenzung möglich sein
|
|||||||
Sheet: Blatt
|
Sheet: Blatt
|
||||||
SheetList tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: #{display tid}-#{display ssh}-#{courseShortHand} Übersicht Übungsblätter
|
SheetList tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: #{display tid}-#{display ssh}-#{courseShortHand} Übersicht Übungsblätter
|
||||||
SheetNewHeading tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: #{display tid}-#{display ssh}-#{courseShortHand} Neues Übungsblatt anlegen
|
SheetNewHeading tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: #{display tid}-#{display ssh}-#{courseShortHand} Neues Übungsblatt anlegen
|
||||||
SheetNewOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: Neues Übungsblatt #{sheetName} wurde im Kurs #{display tid}-#{display ssh}-#{courseShortHand} erfolgreich erstellt.
|
SheetNewOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{sheetName} wurde als neues Übungsblatt im Kurs #{display tid}-#{display ssh}-#{courseShortHand} erfolgreich erstellt.
|
||||||
SheetTitle tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand} #{sheetName}
|
SheetTitle tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand} #{sheetName}
|
||||||
SheetTitleNew tid@TermId ssh@SchoolId courseShortHand@CourseShorthand : #{display tid}-#{display ssh}-#{courseShortHand}: Neues Übungsblatt
|
SheetTitleNew tid@TermId ssh@SchoolId courseShortHand@CourseShorthand : #{display tid}-#{display ssh}-#{courseShortHand}: Neues Übungsblatt
|
||||||
SheetEditHead tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand} #{sheetName} editieren
|
SheetEditHead tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand} #{sheetName} editieren
|
||||||
SheetEditOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: Übungsblatt #{sheetName} aus Kurs #{display tid}-#{display ssh}-#{courseShortHand} wurde gespeichert.
|
SheetEditOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: Übungsblatt #{sheetName} aus Kurs #{display tid}-#{display ssh}-#{courseShortHand} wurde gespeichert.
|
||||||
SheetNameDup tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: Es gibt bereits ein Übungsblatt #{sheetName} in diesem Kurs #{display tid}-#{display ssh}-#{courseShortHand}.
|
SheetNameDup tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: Es gibt bereits ein Übungsblatt #{sheetName} in diesem Kurs #{display tid}-#{display ssh}-#{courseShortHand}.
|
||||||
SheetDelHead tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: Übungsblatt #{sheetName} wirklich aus Kurs #{display tid}-#{display ssh}-#{courseShortHand} herauslöschen?
|
SheetDelHead tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{sheetName} wirklich aus Kurs #{display tid}-#{display ssh}-#{courseShortHand} herauslöschen?
|
||||||
SheetDelText submissionNo@Int: Dies kann nicht mehr rückgängig gemacht werden! Alle Einreichungen gehen ebenfalls verloren! Es gibt #{display submissionNo} Abgaben.
|
SheetDelText submissionNo@Int: Dies kann nicht mehr rückgängig gemacht werden! Alle Einreichungen gehen ebenfalls verloren! Es gibt #{display submissionNo} Abgaben.
|
||||||
SheetDelOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand}: Übungsblatt #{sheetName} gelöscht.
|
SheetDelOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand}: #{sheetName} gelöscht.
|
||||||
|
|
||||||
SheetExercise: Aufgabenstellung
|
SheetExercise: Aufgabenstellung
|
||||||
SheetHint: Hinweis
|
SheetHint: Hinweis
|
||||||
@ -125,9 +128,11 @@ SubmissionFile: Datei zur Abgabe
|
|||||||
SubmissionFiles: Abgegebene Dateien
|
SubmissionFiles: Abgegebene Dateien
|
||||||
SubmissionAlreadyExistsFor email@UserEmail: #{email} hat bereits eine Abgabe zu diesem bÜbungsblatt.
|
SubmissionAlreadyExistsFor email@UserEmail: #{email} hat bereits eine Abgabe zu diesem bÜbungsblatt.
|
||||||
|
|
||||||
|
SubmissionGroupName: Gruppenname
|
||||||
|
|
||||||
CorrectionsTitle: Zugewiesene Korrekturen
|
CorrectionsTitle: Zugewiesene Korrekturen
|
||||||
CourseCorrectionsTitle: Korrekturen für diesen Kurs
|
CourseCorrectionsTitle: Korrekturen für diesen Kurs
|
||||||
CorrectorsHead sheetName@SheetName: Korrektoren für Blatt #{sheetName}
|
CorrectorsHead sheetName@SheetName: Korrektoren für #{sheetName}
|
||||||
|
|
||||||
Unauthorized: Sie haben hierfür keine explizite Berechtigung.
|
Unauthorized: Sie haben hierfür keine explizite Berechtigung.
|
||||||
UnauthorizedAnd l@Text r@Text: (#{l} UND #{r})
|
UnauthorizedAnd l@Text r@Text: (#{l} UND #{r})
|
||||||
@ -165,6 +170,10 @@ Correctors: Korrektoren
|
|||||||
CorState: Status
|
CorState: Status
|
||||||
CorByTut: Nach Tutorium
|
CorByTut: Nach Tutorium
|
||||||
CorProportion: Anteil
|
CorProportion: Anteil
|
||||||
|
CorByProportionOnly proportion@Rational: #{display proportion} Anteile
|
||||||
|
CorByProportionIncludingTutorial proportion@Rational: #{display proportion} Anteile - Tutorium
|
||||||
|
CorByProportionExcludingTutorial proportion@Rational: #{display proportion} Anteile + Tutorium
|
||||||
|
|
||||||
DeleteRow: Zeile entfernen
|
DeleteRow: Zeile entfernen
|
||||||
ProportionNegative: Anteile dürfen nicht negativ sein
|
ProportionNegative: Anteile dürfen nicht negativ sein
|
||||||
CorrectorsUpdated: Korrektoren erfolgreich aktualisiert
|
CorrectorsUpdated: Korrektoren erfolgreich aktualisiert
|
||||||
@ -235,7 +244,9 @@ RatingPointsDone: Abgabe zählt als korrigiert, gdw. Punktezahl gesetzt ist
|
|||||||
FileTitle: Dateiname
|
FileTitle: Dateiname
|
||||||
FileModified: Letzte Änderung
|
FileModified: Letzte Änderung
|
||||||
|
|
||||||
FileCorrected: Korrigiert
|
|
||||||
|
Corrected: Korrigiert
|
||||||
|
FileCorrected: Korrigiert (Dateien)
|
||||||
FileCorrectedDeleted: Korrigiert (gelöscht)
|
FileCorrectedDeleted: Korrigiert (gelöscht)
|
||||||
RatingUpdated: Korrektur gespeichert
|
RatingUpdated: Korrektur gespeichert
|
||||||
RatingDeleted: Korrektur zurückgesetzt
|
RatingDeleted: Korrektur zurückgesetzt
|
||||||
@ -246,6 +257,7 @@ NoUpcomingSheetDeadlines: Keine anstehenden Übungsblätter
|
|||||||
|
|
||||||
AdminFor: Administrator
|
AdminFor: Administrator
|
||||||
LecturerFor: Dozent
|
LecturerFor: Dozent
|
||||||
|
LecturersFor: Dozenten
|
||||||
UserListTitle: Komprehensive Benutzerliste
|
UserListTitle: Komprehensive Benutzerliste
|
||||||
|
|
||||||
DateTimeFormat: Datums- und Uhrzeitformat
|
DateTimeFormat: Datums- und Uhrzeitformat
|
||||||
@ -259,8 +271,10 @@ AmbiguousUTCTime: Der angegebene Zeitpunkt lässt sich nicht eindeutig zu UTC ko
|
|||||||
IllDefinedUTCTime: Der angegebene Zeitpunkt lässt sich nicht zu UTC konvertieren
|
IllDefinedUTCTime: Der angegebene Zeitpunkt lässt sich nicht zu UTC konvertieren
|
||||||
|
|
||||||
LastEdits: Letzte Änderungen
|
LastEdits: Letzte Änderungen
|
||||||
EditedBy name@Text time@Text: Durch #{name} um #{time}
|
EditedBy name@Text time@Text: #{time} durch #{name}
|
||||||
LastEdit: Letzte Änderung
|
LastEdit: Letzte Änderung
|
||||||
|
LastEditByUser: Ihre letzte Bearbeitung
|
||||||
|
NoEditByUser: Nicht von Ihnen bearbeitet
|
||||||
|
|
||||||
SubmissionFilesIgnored: Es wurden Dateien in der hochgeladenen Abgabe ignoriert:
|
SubmissionFilesIgnored: Es wurden Dateien in der hochgeladenen Abgabe ignoriert:
|
||||||
SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe mit Nummer #{toPathPiece smid}.
|
SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe mit Nummer #{toPathPiece smid}.
|
||||||
|
|||||||
1
models
1
models
@ -4,6 +4,7 @@ User json
|
|||||||
matrikelnummer Text Maybe
|
matrikelnummer Text Maybe
|
||||||
email (CI Text)
|
email (CI Text)
|
||||||
displayName Text
|
displayName Text
|
||||||
|
surname Text
|
||||||
maxFavourites Int default=12
|
maxFavourites Int default=12
|
||||||
theme Theme default='Default'
|
theme Theme default='Default'
|
||||||
dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'"
|
dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'"
|
||||||
|
|||||||
20
routes
20
routes
@ -41,12 +41,15 @@
|
|||||||
/profile ProfileR GET POST !free !free
|
/profile ProfileR GET POST !free !free
|
||||||
/profile/data ProfileDataR GET !free !free
|
/profile/data ProfileDataR GET !free !free
|
||||||
|
|
||||||
/terms TermShowR GET !free
|
/term TermShowR GET !free
|
||||||
/terms/current TermCurrentR GET !free
|
/term/current TermCurrentR GET !free
|
||||||
/terms/edit TermEditR GET POST
|
/term/edit TermEditR GET POST
|
||||||
/terms/#TermId/edit TermEditExistR GET
|
/term/#TermId/edit TermEditExistR GET
|
||||||
!/terms/#TermId TermCourseListR GET !free
|
!/term/#TermId TermCourseListR GET !free
|
||||||
!/terms/#TermId/#SchoolId TermSchoolCourseListR GET !free
|
!/term/#TermId/#SchoolId TermSchoolCourseListR GET !free
|
||||||
|
|
||||||
|
/school SchoolListR GET
|
||||||
|
/school/#SchoolId SchoolShowR GET
|
||||||
|
|
||||||
|
|
||||||
-- For Pattern Synonyms see Foundation
|
-- For Pattern Synonyms see Foundation
|
||||||
@ -74,6 +77,11 @@
|
|||||||
/correctors SCorrR GET POST
|
/correctors SCorrR GET POST
|
||||||
!/#SheetFileType/*FilePath SFileR GET !timeANDregistered !timeANDmaterials !corrector
|
!/#SheetFileType/*FilePath SFileR GET !timeANDregistered !timeANDmaterials !corrector
|
||||||
|
|
||||||
|
-- /user/#CryptoUUIDUser
|
||||||
|
-- /users
|
||||||
|
-- /correctors
|
||||||
|
|
||||||
|
|
||||||
/corrections CorrectionsR GET POST !corrector !lecturer
|
/corrections CorrectionsR GET POST !corrector !lecturer
|
||||||
/corrections/upload CorrectionsUploadR GET POST !corrector !lecturer
|
/corrections/upload CorrectionsUploadR GET POST !corrector !lecturer
|
||||||
|
|
||||||
|
|||||||
@ -52,6 +52,7 @@ import Handler.Profile
|
|||||||
import Handler.Users
|
import Handler.Users
|
||||||
import Handler.Admin
|
import Handler.Admin
|
||||||
import Handler.Term
|
import Handler.Term
|
||||||
|
import Handler.School
|
||||||
import Handler.Course
|
import Handler.Course
|
||||||
import Handler.Sheet
|
import Handler.Sheet
|
||||||
import Handler.Submission
|
import Handler.Submission
|
||||||
|
|||||||
@ -145,7 +145,7 @@ pattern CSubmissionR tid ssh csh shn cid ptn
|
|||||||
-- Menus and Favourites
|
-- Menus and Favourites
|
||||||
data MenuItem = MenuItem
|
data MenuItem = MenuItem
|
||||||
{ menuItemLabel :: Text
|
{ menuItemLabel :: Text
|
||||||
, menuItemIcon :: Maybe Text
|
, menuItemIcon :: Maybe Text
|
||||||
, menuItemRoute :: Route UniWorX
|
, menuItemRoute :: Route UniWorX
|
||||||
, menuItemAccessCallback' :: Handler Bool -- Check whether action is shown in ADDITION to authorization (which is always checked)
|
, menuItemAccessCallback' :: Handler Bool -- Check whether action is shown in ADDITION to authorization (which is always checked)
|
||||||
}
|
}
|
||||||
@ -205,6 +205,15 @@ instance RenderMessage UniWorX CorrectorState where
|
|||||||
CorrectorExcused -> renderMessage' MsgCorrectorExcused
|
CorrectorExcused -> renderMessage' MsgCorrectorExcused
|
||||||
where renderMessage' = renderMessage foundation ls
|
where renderMessage' = renderMessage foundation ls
|
||||||
|
|
||||||
|
|
||||||
|
instance RenderMessage UniWorX Load where
|
||||||
|
renderMessage foundation ls = \case
|
||||||
|
(Load {byTutorial=Nothing , byProportion=p}) -> renderMessage' $ MsgCorByProportionOnly p
|
||||||
|
(Load {byTutorial=Just True , byProportion=p}) -> renderMessage' $ MsgCorByProportionIncludingTutorial p
|
||||||
|
(Load {byTutorial=Just False, byProportion=p}) -> renderMessage' $ MsgCorByProportionExcludingTutorial p
|
||||||
|
where renderMessage' = renderMessage foundation ls
|
||||||
|
|
||||||
|
|
||||||
instance RenderMessage UniWorX (UnsupportedAuthPredicate (Route UniWorX)) where
|
instance RenderMessage UniWorX (UnsupportedAuthPredicate (Route UniWorX)) where
|
||||||
renderMessage f ls (UnsupportedAuthPredicate tag route) = renderMessage f ls $ MsgUnsupportedAuthPredicate tag (show route)
|
renderMessage f ls (UnsupportedAuthPredicate tag route) = renderMessage f ls $ MsgUnsupportedAuthPredicate tag (show route)
|
||||||
|
|
||||||
@ -995,6 +1004,13 @@ pageHeading (TermSchoolCourseListR tid ssh)
|
|||||||
School{schoolName=school} <- handlerToWidget $ runDB $ get404 ssh
|
School{schoolName=school} <- handlerToWidget $ runDB $ get404 ssh
|
||||||
i18nHeading $ MsgTermSchoolCourseListHeading tid school
|
i18nHeading $ MsgTermSchoolCourseListHeading tid school
|
||||||
|
|
||||||
|
pageHeading (SchoolListR)
|
||||||
|
= Just $ i18nHeading MsgSchoolListHeading
|
||||||
|
pageHeading (SchoolShowR ssh)
|
||||||
|
= Just $ do
|
||||||
|
School{schoolName=school} <- handlerToWidget $ runDB $ get404 ssh
|
||||||
|
i18nHeading $ MsgSchoolHeading school
|
||||||
|
|
||||||
pageHeading (CourseListR)
|
pageHeading (CourseListR)
|
||||||
= Just $ i18nHeading $ MsgCourseListTitle
|
= Just $ i18nHeading $ MsgCourseListTitle
|
||||||
pageHeading CourseNewR
|
pageHeading CourseNewR
|
||||||
@ -1161,6 +1177,7 @@ instance YesodAuth UniWorX where
|
|||||||
userMatrikelnummer' = lookup (Attr "LMU-Stud-Matrikelnummer") ldapData
|
userMatrikelnummer' = lookup (Attr "LMU-Stud-Matrikelnummer") ldapData
|
||||||
userEmail' = lookup (Attr "mail") ldapData
|
userEmail' = lookup (Attr "mail") ldapData
|
||||||
userDisplayName' = lookup (Attr "displayName") ldapData
|
userDisplayName' = lookup (Attr "displayName") ldapData
|
||||||
|
userSurname' = lookup (Attr "sn") ldapData
|
||||||
|
|
||||||
userEmail <- if
|
userEmail <- if
|
||||||
| Just [bs] <- userEmail'
|
| Just [bs] <- userEmail'
|
||||||
@ -1174,6 +1191,12 @@ instance YesodAuth UniWorX where
|
|||||||
-> return userDisplayName
|
-> return userDisplayName
|
||||||
| otherwise
|
| otherwise
|
||||||
-> throwError $ ServerError "Could not retrieve user name"
|
-> throwError $ ServerError "Could not retrieve user name"
|
||||||
|
userSurname <- if
|
||||||
|
| Just [bs] <- userSurname'
|
||||||
|
, Right userSurname <- Text.decodeUtf8' bs
|
||||||
|
-> return userSurname
|
||||||
|
| otherwise
|
||||||
|
-> throwError $ ServerError "Could not retrieve user surname"
|
||||||
userMatrikelnummer <- if
|
userMatrikelnummer <- if
|
||||||
| Just [bs] <- userMatrikelnummer'
|
| Just [bs] <- userMatrikelnummer'
|
||||||
, Right userMatrikelnummer <- Text.decodeUtf8' bs
|
, Right userMatrikelnummer <- Text.decodeUtf8' bs
|
||||||
@ -1193,10 +1216,11 @@ instance YesodAuth UniWorX where
|
|||||||
, userDownloadFiles = userDefaultDownloadFiles
|
, userDownloadFiles = userDefaultDownloadFiles
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
userUpdate = [ UserMatrikelnummer =. userMatrikelnummer
|
userUpdate = [ UserMatrikelnummer =. userMatrikelnummer
|
||||||
, UserDisplayName =. userDisplayName
|
, UserDisplayName =. userDisplayName
|
||||||
, UserEmail =. userEmail
|
, UserSurname =. userSurname
|
||||||
]
|
, UserEmail =. userEmail
|
||||||
|
]
|
||||||
|
|
||||||
userId <- lift $ entityKey <$> upsertBy uAuth newUser userUpdate
|
userId <- lift $ entityKey <$> upsertBy uAuth newUser userUpdate
|
||||||
|
|
||||||
|
|||||||
@ -23,6 +23,7 @@ import Import
|
|||||||
|
|
||||||
import Handler.Utils
|
import Handler.Utils
|
||||||
import Handler.Utils.Submission
|
import Handler.Utils.Submission
|
||||||
|
import Handler.Utils.Table.Cells
|
||||||
-- import Handler.Utils.Zip
|
-- import Handler.Utils.Zip
|
||||||
|
|
||||||
import Data.Set (Set)
|
import Data.Set (Set)
|
||||||
@ -86,24 +87,24 @@ colTerm = sortable (Just "term") (i18nCell MsgTerm)
|
|||||||
colCourse :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
|
colCourse :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
|
||||||
colCourse = sortable (Just "course") (i18nCell MsgCourse)
|
colCourse = sortable (Just "course") (i18nCell MsgCourse)
|
||||||
$ \DBRow{ dbrOutput=(_, _, course, _, _) } ->
|
$ \DBRow{ dbrOutput=(_, _, course, _, _) } ->
|
||||||
let csh = course ^. _2
|
let tid = course ^. _3
|
||||||
tid = course ^. _3
|
|
||||||
ssh = course ^. _4
|
ssh = course ^. _4
|
||||||
|
csh = course ^. _2
|
||||||
in anchorCell (CourseR tid ssh csh CShowR) [whamlet|#{display csh}|]
|
in anchorCell (CourseR tid ssh csh CShowR) [whamlet|#{display csh}|]
|
||||||
|
|
||||||
colSheet :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
|
colSheet :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
|
||||||
colSheet = sortable (Just "sheet") (i18nCell MsgSheet)
|
colSheet = sortable (Just "sheet") (i18nCell MsgSheet)
|
||||||
$ \DBRow{ dbrOutput=(_, sheet, course, _, _) } ->
|
$ \DBRow{ dbrOutput=(_, sheet, course, _, _) } ->
|
||||||
let csh = course ^. _2
|
let tid = course ^. _3
|
||||||
tid = course ^. _3
|
|
||||||
ssh = course ^. _4
|
ssh = course ^. _4
|
||||||
|
csh = course ^. _2
|
||||||
shn = sheetName $ entityVal sheet
|
shn = sheetName $ entityVal sheet
|
||||||
in anchorCell (CSheetR tid ssh csh shn SShowR) [whamlet|#{display shn}|]
|
in anchorCell (CSheetR tid ssh csh shn SShowR) [whamlet|#{display shn}|]
|
||||||
|
|
||||||
colCorrector :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
|
colCorrector :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
|
||||||
colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case
|
colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case
|
||||||
DBRow{ dbrOutput = (_, _, _, Nothing , _) } -> cell mempty
|
DBRow{ dbrOutput = (_, _, _, Nothing , _) } -> cell mempty
|
||||||
DBRow{ dbrOutput = (_, _, _, Just corr, _) } -> textCell . display . userDisplayName $ entityVal corr
|
DBRow{ dbrOutput = (_, _, _, Just (Entity _ User{..}), _) } -> userCell userDisplayName userSurname
|
||||||
|
|
||||||
colSubmissionLink :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
|
colSubmissionLink :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
|
||||||
colSubmissionLink = sortable Nothing (i18nCell MsgSubmission)
|
colSubmissionLink = sortable Nothing (i18nCell MsgSubmission)
|
||||||
@ -125,6 +126,11 @@ colSubmittors :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
|
|||||||
colSubmittors = sortable Nothing (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, _, _, users) } -> let
|
colSubmittors = sortable Nothing (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, _, _, users) } -> let
|
||||||
cell = listCell (Map.toList users) $ \(userId, User{..}) -> anchorCellM (AdminUserR <$> encrypt userId) (toWidget userDisplayName)
|
cell = listCell (Map.toList users) $ \(userId, User{..}) -> anchorCellM (AdminUserR <$> encrypt userId) (toWidget userDisplayName)
|
||||||
in cell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
|
in cell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
|
||||||
|
|
||||||
|
colSMatrikel :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
|
||||||
|
colSMatrikel = sortable Nothing (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_, _, _, _, users) } -> let
|
||||||
|
cell = listCell (Map.toList users) $ \(userId, User{..}) -> anchorCellM (AdminUserR <$> encrypt userId) (maybe mempty toWidget userMatrikelnummer)
|
||||||
|
in cell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
|
||||||
|
|
||||||
colRating :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
|
colRating :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
|
||||||
colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId Submission{..}, Entity _ Sheet{..}, course, _, _) } ->
|
colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId Submission{..}, Entity _ Sheet{..}, course, _, _) } ->
|
||||||
@ -178,7 +184,7 @@ makeCorrectionsTable whereClause colChoices psValidator = do
|
|||||||
, SortColumn $ \((_ `E.InnerJoin` sheet `E.InnerJoin` _) `E.LeftOuterJoin` _) -> sheet E.^. SheetName
|
, SortColumn $ \((_ `E.InnerJoin` sheet `E.InnerJoin` _) `E.LeftOuterJoin` _) -> sheet E.^. SheetName
|
||||||
)
|
)
|
||||||
, ( "corrector"
|
, ( "corrector"
|
||||||
, SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` corrector) -> corrector E.?. UserDisplayName
|
, SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` corrector) -> corrector E.?. UserSurname
|
||||||
)
|
)
|
||||||
, ( "rating"
|
, ( "rating"
|
||||||
, SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingPoints
|
, SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingPoints
|
||||||
@ -354,6 +360,7 @@ postCCorrectionsR tid ssh csh = do
|
|||||||
, dbRow
|
, dbRow
|
||||||
, colSheet
|
, colSheet
|
||||||
, colCorrector
|
, colCorrector
|
||||||
|
, colSMatrikel
|
||||||
, colSubmittors
|
, colSubmittors
|
||||||
, colSubmissionLink
|
, colSubmissionLink
|
||||||
, colRating
|
, colRating
|
||||||
|
|||||||
@ -16,7 +16,12 @@
|
|||||||
module Handler.Course where
|
module Handler.Course where
|
||||||
|
|
||||||
import Import
|
import Import
|
||||||
|
|
||||||
|
import Control.Lens
|
||||||
|
import Utils.Lens
|
||||||
|
import Utils.TH
|
||||||
import Handler.Utils
|
import Handler.Utils
|
||||||
|
import Handler.Utils.Table.Cells
|
||||||
|
|
||||||
-- import Data.Time
|
-- import Data.Time
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
@ -33,7 +38,7 @@ import qualified Database.Esqueleto as E
|
|||||||
|
|
||||||
import qualified Data.UUID.Cryptographic as UUID
|
import qualified Data.UUID.Cryptographic as UUID
|
||||||
|
|
||||||
|
-- NOTE: Outdated way to use dbTable; see ProfileDataR Handler for a more recent method.
|
||||||
type CourseTableData = DBRow (Entity Course, Int64, Bool, Entity School)
|
type CourseTableData = DBRow (Entity Course, Int64, Bool, Entity School)
|
||||||
|
|
||||||
colCourse :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
colCourse :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||||
@ -42,16 +47,12 @@ colCourse = sortable (Just "course") (i18nCell MsgCourse)
|
|||||||
anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR)
|
anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR)
|
||||||
[whamlet|#{display courseName}|]
|
[whamlet|#{display courseName}|]
|
||||||
|
|
||||||
colCourseDescr :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
colCourseDescr :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
|
||||||
colCourseDescr = sortable (Just "course") (i18nCell MsgCourse)
|
colCourseDescr = sortable (Just "course") (i18nCell MsgCourse) $ do
|
||||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } -> mappend
|
course <- view $ _dbrOutput . _1 . _entityVal
|
||||||
( anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|#{display courseName}|] )
|
return $ courseCell course
|
||||||
( case courseDescription of
|
|
||||||
Nothing -> mempty
|
|
||||||
(Just descr) -> cell [whamlet| <span style="float:right"> ^{modalStatic descr} |]
|
|
||||||
)
|
|
||||||
|
|
||||||
colDescription :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
colDescription :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
|
||||||
colDescription = sortable Nothing (i18nCell MsgCourseDescription)
|
colDescription = sortable Nothing (i18nCell MsgCourseDescription)
|
||||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } ->
|
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } ->
|
||||||
case courseDescription of
|
case courseDescription of
|
||||||
@ -91,7 +92,8 @@ colSchoolShort = sortable (Just "schoolshort") (i18nCell MsgCourseSchoolShort)
|
|||||||
colRegFrom :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
colRegFrom :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||||
colRegFrom = sortable (Just "register-from") (i18nCell MsgRegisterFrom)
|
colRegFrom = sortable (Just "register-from") (i18nCell MsgRegisterFrom)
|
||||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } ->
|
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } ->
|
||||||
cell $ traverse (formatTime SelFormatDateTime) courseRegisterFrom >>= maybe mempty toWidget
|
maybe mempty timeCell courseRegisterFrom
|
||||||
|
-- cell $ traverse (formatTime SelFormatDateTime) courseRegisterFrom >>= maybe mempty toWidget
|
||||||
|
|
||||||
colRegTo :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
colRegTo :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||||
colRegTo = sortable (Just "register-to") (i18nCell MsgRegisterTo)
|
colRegTo = sortable (Just "register-to") (i18nCell MsgRegisterTo)
|
||||||
@ -100,7 +102,7 @@ colRegTo = sortable (Just "register-to") (i18nCell MsgRegisterTo)
|
|||||||
|
|
||||||
colParticipants :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
colParticipants :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||||
colParticipants = sortable (Just "participants") (i18nCell MsgCourseMembers)
|
colParticipants = sortable (Just "participants") (i18nCell MsgCourseMembers)
|
||||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, currentParticipants, _, _) } -> textCell $ case courseCapacity of
|
$ \DBRow{ dbrOutput=(Entity cid Course{..}, currentParticipants, _, _) } -> i18nCell $ case courseCapacity of
|
||||||
Nothing -> MsgCourseMembersCount currentParticipants
|
Nothing -> MsgCourseMembersCount currentParticipants
|
||||||
Just max -> MsgCourseMembersCountLimited currentParticipants max
|
Just max -> MsgCourseMembersCountLimited currentParticipants max
|
||||||
|
|
||||||
@ -161,9 +163,12 @@ makeCourseTable whereClause colChoices psValidator = do
|
|||||||
| Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
|
| Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||||
| otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList criterias)
|
| otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList criterias)
|
||||||
)
|
)
|
||||||
, ( "school", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) criterias -> if
|
-- , ( "school", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) criterias -> if
|
||||||
| Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
|
-- | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||||
| otherwise -> school E.^. SchoolName `E.in_` E.valList (Set.toList criterias)
|
-- | otherwise -> school E.^. SchoolName `E.in_` E.valList (Set.toList criterias)
|
||||||
|
-- )
|
||||||
|
, ( "school", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) ->
|
||||||
|
emptyOrIn $ school E.^. SchoolName -- TODO: Refactor all?!
|
||||||
)
|
)
|
||||||
, ( "schoolshort", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) criterias -> if
|
, ( "schoolshort", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) criterias -> if
|
||||||
| Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
|
| Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||||
@ -249,17 +254,20 @@ getTermCourseListR tid = do
|
|||||||
getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||||
getCShowR tid ssh csh = do
|
getCShowR tid ssh csh = do
|
||||||
mbAid <- maybeAuthId
|
mbAid <- maybeAuthId
|
||||||
(courseEnt,(schoolMB,participants,registered)) <- runDB $ do
|
(courseEnt,(schoolMB,participants,registered),lecturers) <- runDB $ do
|
||||||
courseEnt@(Entity cid course) <- getBy404 $ TermSchoolCourseShort tid ssh csh
|
courseEnt@(Entity cid course) <- getBy404 $ TermSchoolCourseShort tid ssh csh
|
||||||
dependent <- (,,)
|
dependent <- (,,)
|
||||||
<$> get (courseSchool course) -- join -- just fetch full school name here
|
<$> get (courseSchool course) -- join -- just fetch full school name here
|
||||||
<*> count [CourseParticipantCourse ==. cid] -- join
|
<*> count [CourseParticipantCourse ==. cid] -- join
|
||||||
<*> (case mbAid of -- TODO: Someone please refactor this late-night mess here!
|
<*> (case mbAid of -- TODO: Someone please refactor this late-night mess here!
|
||||||
Nothing -> return False
|
Nothing -> return False
|
||||||
(Just aid) -> do
|
(Just aid) -> do regL <- getBy (UniqueParticipant aid cid)
|
||||||
regL <- getBy (UniqueParticipant aid cid)
|
return $ isJust regL)
|
||||||
return $ isJust regL)
|
lecturers <- E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
|
||||||
return $ (courseEnt,dependent)
|
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
||||||
|
E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
|
||||||
|
return $ user E.^. UserDisplayName
|
||||||
|
return $ (courseEnt,dependent,E.unValue <$> lecturers)
|
||||||
let course = entityVal courseEnt
|
let course = entityVal courseEnt
|
||||||
(regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course
|
(regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course
|
||||||
registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid ssh csh CRegisterR) True
|
registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid ssh csh CRegisterR) True
|
||||||
@ -335,7 +343,7 @@ courseDeleteHandler = undefined
|
|||||||
|
|
||||||
courseEditHandler :: Bool -> Maybe (Entity Course) -> Handler Html
|
courseEditHandler :: Bool -> Maybe (Entity Course) -> Handler Html
|
||||||
courseEditHandler isGet course = do
|
courseEditHandler isGet course = do
|
||||||
$logDebug "€€€€€€ courseEditHandler started"
|
-- $logDebug "€€€€€€ courseEditHandler started"
|
||||||
aid <- requireAuthId -- TODO: Verify that Editor is owner of the Course to be Edited!!!
|
aid <- requireAuthId -- TODO: Verify that Editor is owner of the Course to be Edited!!!
|
||||||
((result, formWidget), formEnctype) <- runFormPost . newCourseForm =<< for course courseToForm
|
((result, formWidget), formEnctype) <- runFormPost . newCourseForm =<< for course courseToForm
|
||||||
case result of
|
case result of
|
||||||
|
|||||||
@ -67,16 +67,16 @@ homeAnonymous = do
|
|||||||
colonnade :: Colonnade Sortable (DBRow (Entity Course)) (DBCell (HandlerT UniWorX IO) ())
|
colonnade :: Colonnade Sortable (DBRow (Entity Course)) (DBCell (HandlerT UniWorX IO) ())
|
||||||
colonnade = mconcat
|
colonnade = mconcat
|
||||||
[ -- dbRow
|
[ -- dbRow
|
||||||
sortable (Just "term") (textCell MsgTerm) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
|
sortable (Just "term") (i18nCell MsgTerm) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
|
||||||
textCell $ display $ courseTerm course
|
textCell $ display $ courseTerm course
|
||||||
, sortable (Just "school") (textCell MsgCourseSchool) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
|
, sortable (Just "school") (i18nCell MsgCourseSchool) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
|
||||||
textCell $ display $ courseSchool course
|
textCell $ display $ courseSchool course
|
||||||
, sortable (Just "course") (textCell MsgCourse) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
|
, sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
|
||||||
let tid = courseTerm course
|
let tid = courseTerm course
|
||||||
ssh = courseSchool course
|
ssh = courseSchool course
|
||||||
csh = courseShorthand course
|
csh = courseShorthand course
|
||||||
anchorCell (CourseR tid ssh csh CShowR) (toWidget $ display csh)
|
anchorCell (CourseR tid ssh csh CShowR) (toWidget $ display csh)
|
||||||
, sortable (Just "deadline") (textCell MsgRegisterTo) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
|
, sortable (Just "deadline") (i18nCell MsgRegisterTo) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
|
||||||
cell $ traverse (formatTime SelFormatDateTime) (courseRegisterTo course) >>= maybe mempty toWidget
|
cell $ traverse (formatTime SelFormatDateTime) (courseRegisterTo course) >>= maybe mempty toWidget
|
||||||
]
|
]
|
||||||
((), courseTable) <- dbTable def $ DBTable
|
((), courseTable) <- dbTable def $ DBTable
|
||||||
@ -156,17 +156,17 @@ homeUser uid = do
|
|||||||
colonnade = mconcat
|
colonnade = mconcat
|
||||||
[ -- dbRow
|
[ -- dbRow
|
||||||
-- TOOD: sortable (Just "term") (textCell MsgTerm) $ \DBRow{ dbrOutput=(view _1 -> E.Value tid) } ->
|
-- TOOD: sortable (Just "term") (textCell MsgTerm) $ \DBRow{ dbrOutput=(view _1 -> E.Value tid) } ->
|
||||||
sortable (Just "term") (textCell MsgTerm) $ \DBRow{ dbrOutput=(E.Value tid,_,_,_,_,_) } ->
|
sortable (Just "term") (i18nCell MsgTerm) $ \DBRow{ dbrOutput=(E.Value tid,_,_,_,_,_) } ->
|
||||||
textCell $ display tid
|
textCell $ display tid
|
||||||
, sortable (Just "school") (textCell MsgCourseSchool) $ \DBRow{ dbrOutput=(_,E.Value ssh,_,_,_,_) } ->
|
, sortable (Just "school") (i18nCell MsgCourseSchool) $ \DBRow{ dbrOutput=(_,E.Value ssh,_,_,_,_) } ->
|
||||||
textCell $ display ssh
|
textCell $ display ssh
|
||||||
, sortable (Just "course") (textCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, _, _, _) } ->
|
, sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, _, _, _) } ->
|
||||||
anchorCell (CourseR tid ssh csh CShowR) (toWidget $ display csh)
|
anchorCell (CourseR tid ssh csh CShowR) (toWidget $ display csh)
|
||||||
, sortable (Just "sheet") (textCell MsgSheet) $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, _) } ->
|
, sortable (Just "sheet") (i18nCell MsgSheet) $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, _) } ->
|
||||||
anchorCell (CSheetR tid ssh csh shn SShowR) (toWidget $ display shn)
|
anchorCell (CSheetR tid ssh csh shn SShowR) (toWidget $ display shn)
|
||||||
, sortable (Just "deadline") (textCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, _, E.Value deadline, _) } ->
|
, sortable (Just "deadline") (i18nCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, _, E.Value deadline, _) } ->
|
||||||
cell $ formatTime SelFormatDateTime deadline >>= toWidget
|
cell $ formatTime SelFormatDateTime deadline >>= toWidget
|
||||||
, sortable (Just "done") (textCell MsgDone) $ \(DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, E.Value mbsid) }) ->
|
, sortable (Just "done") (i18nCell MsgDone) $ \(DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, E.Value mbsid) }) ->
|
||||||
case mbsid of
|
case mbsid of
|
||||||
Nothing -> mempty
|
Nothing -> mempty
|
||||||
(Just sid) -> anchorCellM (CSubmissionR tid ssh csh shn <$> encrypt sid <*> pure SubShowR)
|
(Just sid) -> anchorCellM (CSubmissionR tid ssh csh shn <$> encrypt sid <*> pure SubShowR)
|
||||||
|
|||||||
@ -1,12 +1,15 @@
|
|||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
{-# LANGUAGE MultiWayIf, LambdaCase #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
{-# LANGUAGE PatternSynonyms #-}
|
||||||
{-# LANGUAGE PartialTypeSignatures #-}
|
{-# LANGUAGE PartialTypeSignatures #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
|
||||||
module Handler.Profile where
|
module Handler.Profile where
|
||||||
@ -14,10 +17,14 @@ module Handler.Profile where
|
|||||||
import Import
|
import Import
|
||||||
|
|
||||||
import Handler.Utils
|
import Handler.Utils
|
||||||
|
import Handler.Utils.Table.Cells
|
||||||
|
|
||||||
import Utils.Lens
|
import Utils.Lens
|
||||||
-- import Colonnade hiding (fromMaybe, singleton)
|
-- import Colonnade hiding (fromMaybe, singleton)
|
||||||
-- import Yesod.Colonnade
|
-- import Yesod.Colonnade
|
||||||
|
import Data.Monoid (Any(..))
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
-- import qualified Data.Set as Set
|
||||||
import qualified Database.Esqueleto as E
|
import qualified Database.Esqueleto as E
|
||||||
-- import Database.Esqueleto ((^.))
|
-- import Database.Esqueleto ((^.))
|
||||||
|
|
||||||
@ -106,11 +113,10 @@ getProfileR = do
|
|||||||
return (course E.^. CourseTerm, course E.^.CourseSchool, course E.^. CourseShorthand)
|
return (course E.^. CourseTerm, course E.^.CourseSchool, course E.^. CourseShorthand)
|
||||||
)
|
)
|
||||||
<*>
|
<*>
|
||||||
(E.select $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do
|
(E.select $ E.distinct $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do
|
||||||
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
|
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
|
||||||
E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
|
E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
|
||||||
E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid
|
E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid
|
||||||
|
|
||||||
return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand)
|
return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand)
|
||||||
)
|
)
|
||||||
<*>
|
<*>
|
||||||
@ -150,41 +156,320 @@ getProfileDataR = do
|
|||||||
-- mr <- getMessageRender
|
-- mr <- getMessageRender
|
||||||
|
|
||||||
-- Tabelle mit eigenen Kursen
|
-- Tabelle mit eigenen Kursen
|
||||||
|
(hasRows, ownedCoursesTable) <- mkOwnedCoursesTable uid
|
||||||
-- Tabelle mit allen Teilnehmer: Kurs (link), Datum
|
-- Tabelle mit allen Teilnehmer: Kurs (link), Datum
|
||||||
courseTable <- do
|
enrolledCoursesTable <- mkEnrolledCoursesTable uid
|
||||||
let -- should be inlined
|
|
||||||
-- courseCol :: IsDBTable m a => Colonnade Sortable (DBRow (Entity Course, Entity CourseParticipant)) (DBCell m a)
|
|
||||||
courseCol = sortable (Just "course") (i18nCell MsgCourse) $ do -- (->) a Monad
|
|
||||||
Course{..} <- view $ _dbrOutput . _1 . _entityVal -- view == ^.
|
|
||||||
-- "preview _left" in order to match Either (result is Maybe)
|
|
||||||
return $ anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR)
|
|
||||||
(citext2widget courseName)
|
|
||||||
--courseData :: (E.InnerJoin (E.SqlExpr (Entity Course)) (E.SqlExpr (Entity CourseParticipant)))
|
|
||||||
-- -> E.SqlQuery (E.SqlExpr (Entity Course), E.SqlExpr (Entity CourseParticipant))
|
|
||||||
courseData = \(course `E.InnerJoin` participant) -> do
|
|
||||||
E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse
|
|
||||||
E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
|
|
||||||
return (course, participant)
|
|
||||||
dbTableWidget' def $ DBTable
|
|
||||||
{ dbtIdent = "courseMembership" :: Text
|
|
||||||
, dbtSQLQuery = courseData
|
|
||||||
, dbtColonnade = mconcat
|
|
||||||
[ courseCol
|
|
||||||
]
|
|
||||||
, dbtProj = return
|
|
||||||
, dbtSorting = Map.fromList
|
|
||||||
[ ( "course"
|
|
||||||
, SortColumn $ \(course `E.InnerJoin` _) -> course E.^. CourseName )
|
|
||||||
]
|
|
||||||
, dbtFilter = mempty
|
|
||||||
, dbtStyle = def
|
|
||||||
}
|
|
||||||
|
|
||||||
-- Tabelle mit allen Abgaben und Abgabe-Gruppen
|
|
||||||
-- Tabelle mit allen Korrektor-Aufgaben
|
|
||||||
-- Tabelle mit allen Tutorials
|
|
||||||
-- Tabelle mit allen Klausuren und Noten
|
-- Tabelle mit allen Klausuren und Noten
|
||||||
|
examTable <- return [whamlet| TOOD: Klausuranmeldungen anzeigen |] -- TODO
|
||||||
|
-- Tabelle mit allen Abgaben und Abgabe-Gruppen
|
||||||
|
submissionTable <- mkSubmissionTable uid
|
||||||
|
-- Tabelle mit allen Abgabegruppen
|
||||||
|
submissionGroupTable <- mkSubmissionGroupTable uid
|
||||||
|
-- Tabelle mit allen Korrektor-Aufgaben
|
||||||
|
correctionsTable <- mkCorrectionsTable uid
|
||||||
|
-- Tabelle mit allen Tutorials
|
||||||
|
tutorialTable <- return [whamlet| TOOD: Tutorials anzeigen |] -- TODO
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
$(widgetFile "profileData")
|
$(widgetFile "profileData")
|
||||||
$(widgetFile "dsgvDisclaimer")
|
$(widgetFile "dsgvDisclaimer")
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
mkOwnedCoursesTable :: UserId -> Handler (Bool, Widget)
|
||||||
|
-- Table listing all courses that the given user is a lecturer for
|
||||||
|
mkOwnedCoursesTable =
|
||||||
|
let dbtIdent = "courseOwnership" :: Text
|
||||||
|
dbtStyle = def
|
||||||
|
|
||||||
|
withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a)
|
||||||
|
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a)
|
||||||
|
withType = id
|
||||||
|
|
||||||
|
dbtSQLQuery' uid = \(course `E.InnerJoin` lecturer) -> do
|
||||||
|
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
|
||||||
|
E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
|
||||||
|
return ( course E.^. CourseTerm
|
||||||
|
, course E.^. CourseSchool
|
||||||
|
, course E.^. CourseShorthand
|
||||||
|
)
|
||||||
|
dbtProj = \x -> return $ x & _dbrOutput %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))
|
||||||
|
|
||||||
|
dbtColonnade = mconcat
|
||||||
|
[ dbRow
|
||||||
|
, sortable (Just "term") (i18nCell MsgTerm & cellAttrs .~ [("priority","0")]) $ do
|
||||||
|
tid <- view (_dbrOutput . _1)
|
||||||
|
return $ indicatorCell -- return True if one cell is produced here
|
||||||
|
`mappend` termCell tid
|
||||||
|
, sortable (Just "school") (i18nCell MsgCourseSchool) $
|
||||||
|
schoolCell <$> view (_dbrOutput . _1 . re _Just)
|
||||||
|
<*> view (_dbrOutput . _2 )
|
||||||
|
, sortable (Just "course") (i18nCell MsgCourse) $
|
||||||
|
courseCellCL <$> view (_dbrOutput)
|
||||||
|
]
|
||||||
|
|
||||||
|
validator = def & defaultSorting [("term",SortDesc),("school",SortAsc),("course",SortAsc)]
|
||||||
|
dbtSorting = Map.fromList
|
||||||
|
[ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseShorthand)
|
||||||
|
, ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm )
|
||||||
|
, ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool )
|
||||||
|
]
|
||||||
|
dbtFilter = Map.fromList
|
||||||
|
[ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
|
||||||
|
, ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
|
||||||
|
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
|
||||||
|
]
|
||||||
|
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid in (_1 %~ getAny) <$> (dbTableWidget validator DBTable{..})
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
mkEnrolledCoursesTable :: UserId -> Handler Widget
|
||||||
|
-- Table listing all courses that the given user is enrolled in
|
||||||
|
mkEnrolledCoursesTable =
|
||||||
|
let withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
|
||||||
|
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
|
||||||
|
withType = id
|
||||||
|
|
||||||
|
validator = def & defaultSorting [("time",SortDesc)]
|
||||||
|
|
||||||
|
in \uid -> dbTableWidget' validator
|
||||||
|
DBTable
|
||||||
|
{ dbtIdent = "courseMembership" :: Text
|
||||||
|
, dbtSQLQuery = \(course `E.InnerJoin` participant) -> do
|
||||||
|
E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse
|
||||||
|
E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
|
||||||
|
return (course, participant E.^. CourseParticipantRegistration)
|
||||||
|
, dbtProj = \x -> return $ x & _dbrOutput . _2 %~ E.unValue
|
||||||
|
, dbtColonnade = mconcat
|
||||||
|
[ dbRow
|
||||||
|
, sortable (Just "term") (i18nCell MsgTerm) $
|
||||||
|
termCell <$> view (_dbrOutput . _1 . _entityVal . _courseTerm)
|
||||||
|
, sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 . _entityVal) $
|
||||||
|
schoolCell <$> view ( _courseTerm . re _Just)
|
||||||
|
<*> view ( _courseSchool )
|
||||||
|
, sortable (Just "course") (i18nCell MsgCourse) $
|
||||||
|
courseCell <$> view (_dbrOutput . _1 . _entityVal)
|
||||||
|
, sortable (Just "time") (i18nCell MsgRegistered) $ do
|
||||||
|
regTime <- view $ _dbrOutput . _2
|
||||||
|
return $ timeCell regTime
|
||||||
|
]
|
||||||
|
, dbtSorting = Map.fromList
|
||||||
|
[ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseName )
|
||||||
|
, ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm )
|
||||||
|
, ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool)
|
||||||
|
, ( "time" , SortColumn $ \(_ `E.InnerJoin` participant) -> participant E.^. CourseParticipantRegistration)
|
||||||
|
]
|
||||||
|
, dbtFilter = Map.fromList
|
||||||
|
[ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseName )
|
||||||
|
, ( "term" , FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
|
||||||
|
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool)
|
||||||
|
-- , ( "time" , FilterColumn $ \(_ `E.InnerJoin` part :: CourseTableData) -> emptyOrIn $ part E.^. CourseParticipantRegistration )
|
||||||
|
]
|
||||||
|
, dbtStyle = def
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
mkSubmissionTable :: UserId -> Handler Widget
|
||||||
|
-- Table listing all submissions for the given user
|
||||||
|
mkSubmissionTable =
|
||||||
|
let dbtIdent = "submissions" :: Text
|
||||||
|
dbtStyle = def
|
||||||
|
|
||||||
|
withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)`E.InnerJoin` E.SqlExpr (Entity SubmissionUser) )->a)
|
||||||
|
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)`E.InnerJoin` E.SqlExpr (Entity SubmissionUser) )->a)
|
||||||
|
withType = id
|
||||||
|
|
||||||
|
dbtSQLQuery' uid = \(course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` subUser) -> do
|
||||||
|
E.on $ submission E.^. SubmissionId E.==. subUser E.^. SubmissionUserSubmission
|
||||||
|
E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
|
||||||
|
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
|
||||||
|
E.where_ $ subUser E.^. SubmissionUserUser E.==. E.val uid
|
||||||
|
let crse = ( course E.^. CourseTerm
|
||||||
|
, course E.^. CourseSchool
|
||||||
|
, course E.^. CourseShorthand
|
||||||
|
)
|
||||||
|
let sht = ( sheet E.^. SheetName
|
||||||
|
)
|
||||||
|
return (crse, sht, submission, lastSubEdit uid submission)
|
||||||
|
|
||||||
|
lastSubEdit uid submission = -- latest Edit-Time of this user for submission
|
||||||
|
E.sub_select . E.from $ \subEdit -> do
|
||||||
|
E.where_ $ subEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId
|
||||||
|
E.&&. subEdit E.^. SubmissionEditUser E.==. E.val uid
|
||||||
|
return . E.max_ $ subEdit E.^. SubmissionEditTime
|
||||||
|
|
||||||
|
dbtProj = \x -> return $ x
|
||||||
|
& _dbrOutput . _1 %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))
|
||||||
|
& _dbrOutput . _2 %~ E.unValue
|
||||||
|
& _dbrOutput . _4 %~ E.unValue
|
||||||
|
|
||||||
|
dbtColonnade = mconcat
|
||||||
|
[ dbRow
|
||||||
|
, sortable (Just "term") (i18nCell MsgTerm) $
|
||||||
|
termCell <$> view (_dbrOutput . _1 . _1)
|
||||||
|
, sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 ) $
|
||||||
|
schoolCell <$> view ( _1. re _Just)
|
||||||
|
<*> view ( _2 )
|
||||||
|
, sortable (Just "course") (i18nCell MsgCourse) $
|
||||||
|
courseCellCL <$> view (_dbrOutput . _1)
|
||||||
|
, sortable (Just "sheet") (i18nCell MsgSheet) . magnify _dbrOutput $
|
||||||
|
sheetCell <$> view _1
|
||||||
|
<*> view _2
|
||||||
|
, sortable (toNothingS "submission") (i18nCell MsgSubmission) . magnify _dbrOutput $
|
||||||
|
submissionCell <$> view _1
|
||||||
|
<*> view _2
|
||||||
|
<*> view (_3 . _entityKey)
|
||||||
|
-- , sortable (Just "edit") (i18nCell MsgSubmissionEditUser) $ do
|
||||||
|
-- regTime <- view $ _dbrOutput . _4
|
||||||
|
-- return $ maybe mempty timeCell regTime
|
||||||
|
, sortable (Just "edit") (i18nCell MsgLastEditByUser) $
|
||||||
|
maybe mempty timeCell <$> view (_dbrOutput . _4)
|
||||||
|
]
|
||||||
|
|
||||||
|
validator = def -- DUPLICATED CODE: Handler.Corrections
|
||||||
|
& restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
|
||||||
|
& restrictSorting (\name _ -> name /= "corrector")
|
||||||
|
& defaultSorting [("edit",SortDesc)]
|
||||||
|
dbtSorting' uid = Map.fromList
|
||||||
|
[ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseShorthand)
|
||||||
|
, ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseTerm )
|
||||||
|
, ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseSchool )
|
||||||
|
, ( "sheet" , SortColumn $ withType $ \(_ `E.InnerJoin` sheet `E.InnerJoin` _ `E.InnerJoin` _) -> sheet E.^. SheetName )
|
||||||
|
, ( "edit" , SortColumn $ withType $ \(_ `E.InnerJoin` _ `E.InnerJoin` submission `E.InnerJoin` _) -> lastSubEdit uid submission )
|
||||||
|
]
|
||||||
|
dbtFilter = Map.fromList
|
||||||
|
[ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
|
||||||
|
, ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
|
||||||
|
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
|
||||||
|
]
|
||||||
|
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid
|
||||||
|
dbtSorting = dbtSorting' uid
|
||||||
|
in dbTableWidget' validator $ DBTable {..}
|
||||||
|
-- in do dbtSQLQuery <- dbtSQLQuery'
|
||||||
|
-- dbtSorting <- dbtSorting'
|
||||||
|
-- return $ dbTableWidget' validator $ DBTable {..}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
mkSubmissionGroupTable :: UserId -> Handler Widget
|
||||||
|
-- Table listing all submissions for the given user
|
||||||
|
mkSubmissionGroupTable =
|
||||||
|
let dbtIdent = "subGroups" :: Text
|
||||||
|
dbtStyle = def
|
||||||
|
withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroup) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroupUser) )->a)
|
||||||
|
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroup) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroupUser) )->a)
|
||||||
|
withType = id
|
||||||
|
|
||||||
|
dbtSQLQuery' uid = \(course `E.InnerJoin` sgroup `E.InnerJoin` sguser) -> do
|
||||||
|
E.on $ sguser E.^. SubmissionGroupUserSubmissionGroup E.==. sgroup E.^. SubmissionGroupId
|
||||||
|
E.on $ sgroup E.^. SubmissionGroupCourse E.==. course E.^. CourseId
|
||||||
|
E.where_ $ sguser E.^. SubmissionGroupUserUser E.==. E.val uid
|
||||||
|
let crse = ( course E.^. CourseTerm
|
||||||
|
, course E.^. CourseSchool
|
||||||
|
, course E.^. CourseShorthand
|
||||||
|
)
|
||||||
|
return (crse, sgroup, lastSGEdit sgroup)
|
||||||
|
|
||||||
|
lastSGEdit sgroup = -- latest Edit-Time of this Submission Group by a user
|
||||||
|
E.sub_select . E.from $ \(user `E.InnerJoin` sgEdit) -> do
|
||||||
|
E.on $ user E.^. UserId E.==. sgEdit E.^. SubmissionGroupEditUser
|
||||||
|
E.where_ $ sgEdit E.^. SubmissionGroupEditSubmissionGroup E.==. sgroup E.^. SubmissionGroupId
|
||||||
|
return . E.max_ $ sgEdit E.^. SubmissionGroupEditTime
|
||||||
|
|
||||||
|
dbtProj = \x -> return $ x
|
||||||
|
& _dbrOutput . _1 %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))
|
||||||
|
& _dbrOutput . _3 %~ E.unValue
|
||||||
|
|
||||||
|
dbtColonnade = mconcat
|
||||||
|
[ dbRow
|
||||||
|
, sortable (Just "term") (i18nCell MsgTerm) $
|
||||||
|
termCell <$> view (_dbrOutput . _1 . _1)
|
||||||
|
, sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 ) $
|
||||||
|
schoolCell <$> view ( _1. re _Just)
|
||||||
|
<*> view ( _2 )
|
||||||
|
, sortable (Just "course") (i18nCell MsgCourse) $
|
||||||
|
courseCellCL <$> view (_dbrOutput . _1)
|
||||||
|
, sortable (Just "submissiongroup") (i18nCell MsgSubmissionGroupName) . magnify (_dbrOutput . _2 . _entityVal) $
|
||||||
|
maybe mempty textCell <$> view _submissionGroupName
|
||||||
|
, sortable (Just "edit") (i18nCell MsgLastEdit) $
|
||||||
|
maybe mempty timeCell <$> view (_dbrOutput . _3)
|
||||||
|
]
|
||||||
|
|
||||||
|
validator = def -- DUPLICATED CODE: Handler.Corrections
|
||||||
|
& restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
|
||||||
|
& restrictSorting (\name _ -> name /= "corrector")
|
||||||
|
& defaultSorting [("edit",SortDesc)]
|
||||||
|
dbtSorting = Map.fromList
|
||||||
|
[ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseShorthand)
|
||||||
|
, ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseTerm )
|
||||||
|
, ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseSchool )
|
||||||
|
, ( "submissiongroup" , SortColumn $ withType $ \(_ `E.InnerJoin` sgroup `E.InnerJoin` _) -> sgroup E.^. SubmissionGroupName )
|
||||||
|
, ( "edit" , SortColumn $ withType $ \(_ `E.InnerJoin` sgroup `E.InnerJoin` _ ) -> lastSGEdit sgroup)
|
||||||
|
]
|
||||||
|
dbtFilter = Map.fromList
|
||||||
|
[ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
|
||||||
|
, ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
|
||||||
|
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
|
||||||
|
]
|
||||||
|
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid
|
||||||
|
in dbTableWidget' validator $ DBTable {..}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
mkCorrectionsTable :: UserId -> Handler Widget
|
||||||
|
-- Table listing all corrections made by the given user
|
||||||
|
mkCorrectionsTable =
|
||||||
|
let dbtIdent = "corrections" :: Text
|
||||||
|
dbtStyle = def
|
||||||
|
-- TODO Continue here
|
||||||
|
withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity SheetCorrector))->a)
|
||||||
|
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity SheetCorrector))->a)
|
||||||
|
withType = id
|
||||||
|
|
||||||
|
dbtSQLQuery' uid = \(course `E.InnerJoin` sheet `E.InnerJoin` corrector) -> do
|
||||||
|
E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
|
||||||
|
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
|
||||||
|
E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid
|
||||||
|
let crse = ( course E.^. CourseTerm
|
||||||
|
, course E.^. CourseSchool
|
||||||
|
, course E.^. CourseShorthand
|
||||||
|
)
|
||||||
|
return (crse, sheet E.^. SheetName, corrector)
|
||||||
|
|
||||||
|
dbtProj = \x -> return $ x
|
||||||
|
& _dbrOutput . _1 %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))
|
||||||
|
& _dbrOutput . _2 %~ E.unValue
|
||||||
|
|
||||||
|
dbtColonnade = mconcat
|
||||||
|
[ dbRow
|
||||||
|
, sortable (Just "term") (i18nCell MsgTerm) $
|
||||||
|
termCellCL <$> view (_dbrOutput . _1)
|
||||||
|
, sortable (Just "school") (i18nCell MsgCourseSchool) $
|
||||||
|
schoolCellCL <$> view (_dbrOutput . _1)
|
||||||
|
, sortable (Just "course") (i18nCell MsgCourse) $
|
||||||
|
courseCellCL <$> view (_dbrOutput . _1)
|
||||||
|
, sortable (Just "sheet") (i18nCell MsgSheet) . magnify _dbrOutput $
|
||||||
|
sheetCell <$> view _1 <*> view _2
|
||||||
|
, sortable (Just "cstate") (i18nCell MsgCorState) $
|
||||||
|
correctorStateCell <$> view (_dbrOutput . _3 . _entityVal)
|
||||||
|
, sortable (toNothing "cload") (i18nCell MsgCorProportion) $
|
||||||
|
correctorLoadCell <$> view (_dbrOutput . _3 . _entityVal)
|
||||||
|
]
|
||||||
|
|
||||||
|
validator = def & defaultSorting [("term",SortDesc),("school",SortAsc),("course",SortAsc),("sheet",SortAsc)]
|
||||||
|
dbtSorting = Map.fromList
|
||||||
|
[ ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseTerm )
|
||||||
|
, ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseSchool )
|
||||||
|
, ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseShorthand)
|
||||||
|
, ( "sheet" , SortColumn $ withType $ \(_ `E.InnerJoin` sheet `E.InnerJoin` _) -> sheet E.^. SheetName )
|
||||||
|
, ( "cstate", SortColumn $ withType $ \(_ `E.InnerJoin` _ `E.InnerJoin` cs) -> cs E.^. SheetCorrectorState )
|
||||||
|
]
|
||||||
|
dbtFilter = Map.fromList
|
||||||
|
[ ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
|
||||||
|
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
|
||||||
|
, ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
|
||||||
|
]
|
||||||
|
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid
|
||||||
|
in dbTableWidget' validator $ DBTable {..}
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
53
src/Handler/School.hs
Normal file
53
src/Handler/School.hs
Normal file
@ -0,0 +1,53 @@
|
|||||||
|
{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE MultiWayIf #-}
|
||||||
|
{-# LANGUAGE PartialTypeSignatures #-}
|
||||||
|
{-# LANGUAGE RecordWildCards, NamedFieldPuns, TupleSections #-}
|
||||||
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
|
||||||
|
module Handler.School where
|
||||||
|
|
||||||
|
import Import
|
||||||
|
|
||||||
|
-- import Control.Lens
|
||||||
|
-- import Utils.Lens
|
||||||
|
-- import Utils.TH
|
||||||
|
-- import Handler.Utils
|
||||||
|
-- import Handler.Utils.Table.Cells
|
||||||
|
--
|
||||||
|
-- -- import Data.Time
|
||||||
|
-- import qualified Data.Text as T
|
||||||
|
-- import Data.Function ((&))
|
||||||
|
-- -- import Yesod.Form.Bootstrap3
|
||||||
|
--
|
||||||
|
-- import qualified Data.Set as Set
|
||||||
|
-- import qualified Data.Map as Map
|
||||||
|
--
|
||||||
|
-- import Colonnade hiding (fromMaybe,bool)
|
||||||
|
--
|
||||||
|
-- import qualified Database.Esqueleto as E
|
||||||
|
--
|
||||||
|
-- import qualified Data.UUID.Cryptographic as UUID
|
||||||
|
|
||||||
|
|
||||||
|
getSchoolListR :: Handler Html
|
||||||
|
getSchoolListR = do
|
||||||
|
-- muid <- maybeAuthId
|
||||||
|
defaultLayout $ do
|
||||||
|
[whamlet|TODO: Liste aller Institute |] -- TODO
|
||||||
|
|
||||||
|
|
||||||
|
getSchoolShowR :: SchoolId -> Handler Html
|
||||||
|
getSchoolShowR ssh = do -- TODO
|
||||||
|
-- muid <- maybeAuthId
|
||||||
|
defaultLayout $ do
|
||||||
|
[whamlet|TODO: Informationen zu einem Institut |] -- TODO
|
||||||
|
|
||||||
@ -274,7 +274,7 @@ getSShowR tid ssh csh shn = do
|
|||||||
-- return desired columns
|
-- return desired columns
|
||||||
return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType)
|
return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType)
|
||||||
let colonnadeFiles = widgetColonnade $ mconcat
|
let colonnadeFiles = widgetColonnade $ mconcat
|
||||||
[ sortable (Just "type") "Typ" $ \(_,_, E.Value ftype) -> stringCell ftype
|
[ sortable (Just "type") "Typ" $ \(_,_, E.Value ftype) -> i18nCell ftype
|
||||||
, sortable (Just "path") "Dateiname" $ anchorCell' (\(E.Value fName,_,E.Value fType) -> CSheetR tid ssh csh shn (SFileR fType fName))
|
, sortable (Just "path") "Dateiname" $ anchorCell' (\(E.Value fName,_,E.Value fType) -> CSheetR tid ssh csh shn (SFileR fType fName))
|
||||||
(\(E.Value fName,_,_) -> str2widget fName)
|
(\(E.Value fName,_,_) -> str2widget fName)
|
||||||
, sortable (Just "time") "Modifikation" $ \(_,E.Value modified,_) -> cell $ formatTime SelFormatDateTime (modified :: UTCTime) >>= toWidget
|
, sortable (Just "time") "Modifikation" $ \(_,E.Value modified,_) -> cell $ formatTime SelFormatDateTime (modified :: UTCTime) >>= toWidget
|
||||||
@ -349,7 +349,32 @@ getSFileR tid ssh csh shn typ title = do
|
|||||||
|
|
||||||
getSheetNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
getSheetNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||||
getSheetNewR tid ssh csh = do
|
getSheetNewR tid ssh csh = do
|
||||||
let template = Nothing -- TODO: provide convenience by interpolating name/nr/dates+7days
|
lastSheets <- runDB $ E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
|
||||||
|
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
|
||||||
|
E.where_ $ course E.^. CourseTerm E.==. E.val tid
|
||||||
|
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||||
|
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||||
|
E.orderBy [E.desc (sheet E.^. SheetActiveFrom)]
|
||||||
|
E.limit 1
|
||||||
|
return sheet
|
||||||
|
let template = case lastSheets of
|
||||||
|
((Entity {entityVal=Sheet{..}}):_) -> Just $ SheetForm
|
||||||
|
{ sfName = stepTextCounterCI sheetName
|
||||||
|
, sfDescription = sheetDescription
|
||||||
|
, sfType = sheetType
|
||||||
|
, sfGrouping = sheetGrouping
|
||||||
|
, sfMarkingText = sheetMarkingText
|
||||||
|
, sfVisibleFrom = addOneWeek <$> sheetVisibleFrom
|
||||||
|
, sfActiveFrom = addOneWeek sheetActiveFrom
|
||||||
|
, sfActiveTo = addOneWeek sheetActiveTo
|
||||||
|
, sfSheetF = Nothing
|
||||||
|
, sfHintFrom = addOneWeek <$> sheetHintFrom
|
||||||
|
, sfHintF = Nothing
|
||||||
|
, sfSolutionFrom = addOneWeek <$> sheetSolutionFrom
|
||||||
|
, sfSolutionF = Nothing
|
||||||
|
, sfMarkingF = Nothing
|
||||||
|
}
|
||||||
|
_other -> Nothing
|
||||||
let action newSheet = -- More specific error message for new sheet could go here, if insertUnique returns Nothing
|
let action newSheet = -- More specific error message for new sheet could go here, if insertUnique returns Nothing
|
||||||
insertUnique $ newSheet
|
insertUnique $ newSheet
|
||||||
handleSheetEdit tid ssh csh Nothing template action
|
handleSheetEdit tid ssh csh Nothing template action
|
||||||
|
|||||||
@ -23,6 +23,7 @@ import Import hiding (joinPath)
|
|||||||
-- import Yesod.Form.Bootstrap3
|
-- import Yesod.Form.Bootstrap3
|
||||||
|
|
||||||
import Handler.Utils
|
import Handler.Utils
|
||||||
|
import Handler.Utils.Table.Cells
|
||||||
|
|
||||||
import Network.Mime
|
import Network.Mime
|
||||||
|
|
||||||
@ -30,6 +31,7 @@ import Control.Monad.Trans.Maybe
|
|||||||
import Control.Monad.State.Class
|
import Control.Monad.State.Class
|
||||||
import Control.Monad.Trans.State.Strict (StateT)
|
import Control.Monad.Trans.State.Strict (StateT)
|
||||||
|
|
||||||
|
import Data.Monoid (Any(..))
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
import qualified Data.Maybe
|
import qualified Data.Maybe
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
@ -56,9 +58,9 @@ import Colonnade hiding (bool, fromMaybe)
|
|||||||
import qualified Yesod.Colonnade as Yesod
|
import qualified Yesod.Colonnade as Yesod
|
||||||
import qualified Text.Blaze.Html5.Attributes as HA
|
import qualified Text.Blaze.Html5.Attributes as HA
|
||||||
|
|
||||||
|
-- DEPRECATED: We always show all edits!
|
||||||
numberOfSubmissionEditDates :: Int64
|
-- numberOfSubmissionEditDates :: Int64
|
||||||
numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production.
|
-- numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production.
|
||||||
|
|
||||||
|
|
||||||
makeSubmissionForm :: Maybe SubmissionId -> Bool -> SheetGroup -> [UserEmail] -> Form (Maybe (Source Handler File), [UserEmail])
|
makeSubmissionForm :: Maybe SubmissionId -> Bool -> SheetGroup -> [UserEmail] -> Form (Maybe (Source Handler File), [UserEmail])
|
||||||
@ -105,8 +107,11 @@ getSubmissionOwnR tid ssh csh shn = do
|
|||||||
|
|
||||||
submissionHelper :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SubmissionMode -> Handler Html
|
submissionHelper :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SubmissionMode -> Handler Html
|
||||||
submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
||||||
uid <- requireAuthId
|
uid <- requireAuthId
|
||||||
msmid <- traverse decrypt mcid
|
msmid <- traverse decrypt mcid
|
||||||
|
actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute
|
||||||
|
maySubmit <- (== Authorized) <$> isAuthorized actionUrl True -- affects visibility of Edit-Dates, Submission-Button, etc.
|
||||||
|
|
||||||
(Entity shid Sheet{..}, buddies, lastEdits) <- runDB $ do
|
(Entity shid Sheet{..}, buddies, lastEdits) <- runDB $ do
|
||||||
sheet@(Entity shid Sheet{..}) <- fetchSheet tid ssh csh shn
|
sheet@(Entity shid Sheet{..}) <- fetchSheet tid ssh csh shn
|
||||||
case msmid of
|
case msmid of
|
||||||
@ -135,7 +140,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
|||||||
E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid
|
E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid
|
||||||
E.orderBy [E.asc $ user E.^. UserEmail]
|
E.orderBy [E.asc $ user E.^. UserEmail]
|
||||||
return $ user E.^. UserEmail
|
return $ user E.^. UserEmail
|
||||||
return (sheet,buddies,[])
|
return (sheet, map E.unValue buddies, [])
|
||||||
(E.Value smid:_) -> do
|
(E.Value smid:_) -> do
|
||||||
cID <- encrypt smid
|
cID <- encrypt smid
|
||||||
addMessageI "info" $ MsgSubmissionAlreadyExists
|
addMessageI "info" $ MsgSubmissionAlreadyExists
|
||||||
@ -145,23 +150,31 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
|||||||
|
|
||||||
shid' <- submissionSheet <$> get404 smid
|
shid' <- submissionSheet <$> get404 smid
|
||||||
-- fetch buddies from current submission
|
-- fetch buddies from current submission
|
||||||
buddies <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
|
(Any isOwner, buddies) <- do
|
||||||
E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId)
|
submittors <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
|
||||||
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val smid
|
E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId)
|
||||||
E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid
|
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val smid
|
||||||
E.orderBy [E.asc $ user E.^. UserEmail]
|
E.orderBy [E.asc $ user E.^. UserEmail]
|
||||||
return $ user E.^. UserEmail
|
return $ (user E.^. UserId, user E.^. UserEmail)
|
||||||
-- mLastEdit <- selectFirst [SubmissionEditSubmission ==. smid] [Desc SubmissionEditTime]
|
let breakUserFromBuddies (E.Value userID, E.Value email)
|
||||||
lastEditValues <- E.select . E.from $ \(user `E.InnerJoin` submissionEdit) -> do
|
| uid == userID = (Any True , [])
|
||||||
E.on (user E.^. UserId E.==. submissionEdit E.^. SubmissionEditUser)
|
| otherwise = (Any False, [email])
|
||||||
E.where_ $ submissionEdit E.^. SubmissionEditSubmission E.==. E.val smid
|
return $ foldMap breakUserFromBuddies submittors
|
||||||
E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
|
|
||||||
E.limit numberOfSubmissionEditDates
|
lastEdits <- do
|
||||||
return $ (user E.^. UserDisplayName, submissionEdit E.^. SubmissionEditTime)
|
raw <- E.select . E.from $ \(user `E.InnerJoin` submissionEdit) -> do
|
||||||
lastEdits <- forM lastEditValues $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
|
E.on (user E.^. UserId E.==. submissionEdit E.^. SubmissionEditUser)
|
||||||
|
E.where_ $ submissionEdit E.^. SubmissionEditSubmission E.==. E.val smid
|
||||||
|
E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
|
||||||
|
-- E.limit numberOfSubmissionEditDates -- DEPRECATED we always show all edit times
|
||||||
|
let userName = if isOwner || maySubmit
|
||||||
|
then E.just $ user E.^. UserDisplayName
|
||||||
|
else E.nothing
|
||||||
|
return $ (userName, submissionEdit E.^. SubmissionEditTime)
|
||||||
|
forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
|
||||||
return (sheet,buddies,lastEdits)
|
return (sheet,buddies,lastEdits)
|
||||||
let unpackZips = True -- undefined -- TODO
|
let unpackZips = True -- undefined -- TODO
|
||||||
((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid unpackZips sheetGrouping $ map E.unValue buddies
|
((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid unpackZips sheetGrouping buddies
|
||||||
mCID <- runDB $ do
|
mCID <- runDB $ do
|
||||||
res' <- case res of
|
res' <- case res of
|
||||||
(FormMissing ) -> return $ FormMissing
|
(FormMissing ) -> return $ FormMissing
|
||||||
@ -242,13 +255,10 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
|||||||
Just cID -> redirect $ CSubmissionR tid ssh csh shn cID SubShowR
|
Just cID -> redirect $ CSubmissionR tid ssh csh shn cID SubShowR
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
|
|
||||||
actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute
|
|
||||||
maySubmit <- (== Authorized) <$> isAuthorized actionUrl True
|
|
||||||
|
|
||||||
-- Maybe construct a table to display uploaded archive files
|
-- Maybe construct a table to display uploaded archive files
|
||||||
let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (HandlerT UniWorX IO) ())
|
let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (HandlerT UniWorX IO) ())
|
||||||
colonnadeFiles cid = mconcat
|
colonnadeFiles cid = mconcat
|
||||||
[ sortable (Just "path") (textCell MsgFileTitle) $ \(coalesce -> (mOrig, mCorr)) -> let
|
[ sortable (Just "path") (i18nCell MsgFileTitle) $ \(coalesce -> (mOrig, mCorr)) -> let
|
||||||
Just fileTitle' = fileTitle . entityVal . snd <$> (mOrig <|> mCorr)
|
Just fileTitle' = fileTitle . entityVal . snd <$> (mOrig <|> mCorr)
|
||||||
origIsFile = fmap (isJust . fileContent . entityVal . snd) mOrig
|
origIsFile = fmap (isJust . fileContent . entityVal . snd) mOrig
|
||||||
corrIsFile = fmap (isJust . fileContent . entityVal . snd) mCorr
|
corrIsFile = fmap (isJust . fileContent . entityVal . snd) mCorr
|
||||||
@ -257,17 +267,17 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
|||||||
| Just True <- origIsFile -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionOriginal fileTitle')
|
| Just True <- origIsFile -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionOriginal fileTitle')
|
||||||
([whamlet|#{fileTitle'}|])
|
([whamlet|#{fileTitle'}|])
|
||||||
| otherwise -> textCell $ bool (<> "/") id isFile fileTitle'
|
| otherwise -> textCell $ bool (<> "/") id isFile fileTitle'
|
||||||
, sortable Nothing (cell mempty) $ \(coalesce -> (_, mCorr)) -> case mCorr of
|
, sortable (toNothing "state") (i18nCell MsgCorState) $ \(coalesce -> (_, mCorr)) -> case mCorr of
|
||||||
Nothing -> cell mempty
|
Nothing -> cell mempty
|
||||||
Just (_, Entity _ File{..})
|
Just (_, Entity _ File{..})
|
||||||
| isJust fileContent -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionCorrected fileTitle)
|
| isJust fileContent -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionCorrected fileTitle)
|
||||||
([whamlet|_{MsgFileCorrected}|])
|
([whamlet|_{MsgFileCorrected}|])
|
||||||
| otherwise -> textCell MsgFileCorrected
|
| otherwise -> i18nCell MsgCorrected
|
||||||
, sortable (Just "time") (textCell MsgFileModified) $ \(coalesce -> (mOrig, mCorr)) -> let
|
, sortable (Just "time") (i18nCell MsgFileModified) $ \(coalesce -> (mOrig, mCorr)) -> let
|
||||||
origTime = fileModified . entityVal . snd <$> mOrig
|
origTime = fileModified . entityVal . snd <$> mOrig
|
||||||
corrTime = fileModified . entityVal . snd <$> mCorr
|
corrTime = fileModified . entityVal . snd <$> mCorr
|
||||||
Just fileTime = (max <$> origTime <*> corrTime) <|> origTime <|> corrTime
|
Just fileTime = (max <$> origTime <*> corrTime) <|> origTime <|> corrTime
|
||||||
in textCell $ display fileTime
|
in timeCell fileTime
|
||||||
]
|
]
|
||||||
coalesce :: ((Maybe (Entity SubmissionFile), Maybe (Entity File)), (Maybe (Entity SubmissionFile), Maybe (Entity File))) -> (Maybe (Entity SubmissionFile, Entity File), Maybe (Entity SubmissionFile, Entity File))
|
coalesce :: ((Maybe (Entity SubmissionFile), Maybe (Entity File)), (Maybe (Entity SubmissionFile), Maybe (Entity File))) -> (Maybe (Entity SubmissionFile, Entity File), Maybe (Entity SubmissionFile, Entity File))
|
||||||
coalesce ((ma, mb), (mc, md)) = ((,) <$> ma <*> mb, (,) <$> mc <*> md)
|
coalesce ((ma, mb), (mc, md)) = ((,) <$> ma <*> mb, (,) <$> mc <*> md)
|
||||||
@ -303,6 +313,8 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
|||||||
|
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitleI $ MsgSubmissionEditHead tid ssh csh shn
|
setTitleI $ MsgSubmissionEditHead tid ssh csh shn
|
||||||
|
let urlArchive cID = CSubmissionR tid ssh csh shn cID (SubArchiveR (ZIPArchiveName SubmissionCorrected))
|
||||||
|
urlOriginal cID = CSubmissionR tid ssh csh shn cID (SubArchiveR (ZIPArchiveName SubmissionOriginal))
|
||||||
$(widgetFile "submission")
|
$(widgetFile "submission")
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@ -33,9 +33,9 @@ getUsersR = do
|
|||||||
let
|
let
|
||||||
dbtColonnade = dbColonnade . mconcat $
|
dbtColonnade = dbColonnade . mconcat $
|
||||||
[ dbRow
|
[ dbRow
|
||||||
, sortable (Just "display-name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
|
, sortable (Just "name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
|
||||||
(AdminUserR <$> encrypt uid)
|
(AdminUserR <$> encrypt uid)
|
||||||
(toWidget . display $ userDisplayName)
|
(nameWidget userDisplayName userSurname)
|
||||||
, sortable (Just "matriculation") (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
|
, sortable (Just "matriculation") (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
|
||||||
(AdminUserR <$> encrypt uid)
|
(AdminUserR <$> encrypt uid)
|
||||||
(toWidget . display $ userMatrikelnummer)
|
(toWidget . display $ userMatrikelnummer)
|
||||||
@ -73,22 +73,22 @@ getUsersR = do
|
|||||||
|]
|
|]
|
||||||
]
|
]
|
||||||
psValidator = def
|
psValidator = def
|
||||||
& defaultSorting [("display-name", SortAsc)]
|
& defaultSorting [("name", SortAsc),("display-name", SortAsc)]
|
||||||
|
|
||||||
((), userList) <- dbTable psValidator $ DBTable
|
((), userList) <- dbTable psValidator $ DBTable
|
||||||
{ dbtSQLQuery = return :: E.SqlExpr (Entity User) -> E.SqlQuery (E.SqlExpr (Entity User))
|
{ dbtSQLQuery = return :: E.SqlExpr (Entity User) -> E.SqlQuery (E.SqlExpr (Entity User))
|
||||||
, dbtColonnade
|
, dbtColonnade
|
||||||
, dbtProj = return
|
, dbtProj = return
|
||||||
, dbtSorting = Map.fromList
|
, dbtSorting = Map.fromList
|
||||||
[ ( "display-name"
|
[ ( "name"
|
||||||
|
, SortColumn $ \user -> user E.^. UserSurname
|
||||||
|
)
|
||||||
|
, ( "display-name"
|
||||||
, SortColumn $ \user -> user E.^. UserDisplayName
|
, SortColumn $ \user -> user E.^. UserDisplayName
|
||||||
)
|
)
|
||||||
, ( "matriculation"
|
, ( "matriculation"
|
||||||
, SortColumn $ \user -> user E.^. UserMatrikelnummer
|
, SortColumn $ \user -> user E.^. UserMatrikelnummer
|
||||||
)
|
)
|
||||||
-- , ( "last-name"
|
|
||||||
-- , SortColumn $ \user -> (last . impureNonNull . words) <$> (user E.^. UserDisplayName)
|
|
||||||
-- )
|
|
||||||
]
|
]
|
||||||
, dbtFilter = mempty
|
, dbtFilter = mempty
|
||||||
, dbtStyle = def
|
, dbtStyle = def
|
||||||
|
|||||||
@ -11,6 +11,8 @@ module Handler.Utils
|
|||||||
|
|
||||||
import Import
|
import Import
|
||||||
|
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
import Handler.Utils.DateTime as Handler.Utils
|
import Handler.Utils.DateTime as Handler.Utils
|
||||||
import Handler.Utils.Form as Handler.Utils
|
import Handler.Utils.Form as Handler.Utils
|
||||||
import Handler.Utils.Table as Handler.Utils
|
import Handler.Utils.Table as Handler.Utils
|
||||||
@ -31,3 +33,15 @@ downloadFiles = do
|
|||||||
Nothing -> do
|
Nothing -> do
|
||||||
AppSettings{ appUserDefaults = UserDefaultConf{..} } <- getsYesod appSettings
|
AppSettings{ appUserDefaults = UserDefaultConf{..} } <- getsYesod appSettings
|
||||||
return userDefaultDownloadFiles
|
return userDefaultDownloadFiles
|
||||||
|
|
||||||
|
|
||||||
|
nameWidget :: Text -> Text -> Widget
|
||||||
|
nameWidget displayName surname
|
||||||
|
| null surname = toWidget displayName
|
||||||
|
| otherwise = case reverse $ T.splitOn surname displayName of
|
||||||
|
[_notContained] -> [whamlet|#{displayName} (<b .surname>#{surname}</b>)|]
|
||||||
|
(suffix:prefixes) ->
|
||||||
|
let prefix = T.intercalate surname $ reverse prefixes
|
||||||
|
in [whamlet|#{prefix}<b .surname>#{surname}</b>#{suffix}|]
|
||||||
|
[] -> error "Data.Text.splitOn returned empty list in violation of specification."
|
||||||
|
|
||||||
|
|||||||
@ -8,10 +8,10 @@
|
|||||||
module Handler.Utils.DateTime
|
module Handler.Utils.DateTime
|
||||||
( utcToLocalTime
|
( utcToLocalTime
|
||||||
, localTimeToUTC, TZ.LocalToUTCResult(..)
|
, localTimeToUTC, TZ.LocalToUTCResult(..)
|
||||||
, formatTime'
|
, formatTime, formatTime', formatTimeW
|
||||||
, formatTime
|
|
||||||
, getTimeLocale, getDateTimeFormat
|
, getTimeLocale, getDateTimeFormat
|
||||||
, validDateTimeFormats, dateTimeFormatOptions
|
, validDateTimeFormats, dateTimeFormatOptions
|
||||||
|
, addOneWeek
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Import
|
import Import
|
||||||
@ -20,6 +20,7 @@ import Data.Time.Zones hiding (localTimeToUTCFull)
|
|||||||
import qualified Data.Time.Zones as TZ
|
import qualified Data.Time.Zones as TZ
|
||||||
|
|
||||||
import Data.Time hiding (formatTime, localTimeToUTC, utcToLocalTime)
|
import Data.Time hiding (formatTime, localTimeToUTC, utcToLocalTime)
|
||||||
|
import Data.Time.Clock (addUTCTime,nominalDay)
|
||||||
import qualified Data.Time.Format as Time
|
import qualified Data.Time.Format as Time
|
||||||
|
|
||||||
import Data.Set (Set)
|
import Data.Set (Set)
|
||||||
@ -51,6 +52,12 @@ formatTime' fmtStr t = fmap fromString $ Time.formatTime <$> getTimeLocale <*> p
|
|||||||
formatTime :: (HasLocalTime t, MonadHandler m, HandlerSite m ~ UniWorX) => SelDateTimeFormat -> t -> m Text
|
formatTime :: (HasLocalTime t, MonadHandler m, HandlerSite m ~ UniWorX) => SelDateTimeFormat -> t -> m Text
|
||||||
formatTime proj t = flip formatTime' t =<< (unDateTimeFormat <$> getDateTimeFormat proj)
|
formatTime proj t = flip formatTime' t =<< (unDateTimeFormat <$> getDateTimeFormat proj)
|
||||||
|
|
||||||
|
-- formatTimeH :: (HasLocalTime t) => SelDateTimeFormat -> t -> Handler Text
|
||||||
|
-- formatTimeH = formatTime
|
||||||
|
|
||||||
|
formatTimeW :: (HasLocalTime t) => SelDateTimeFormat -> t -> Widget
|
||||||
|
formatTimeW s t = toWidget =<< formatTime s t
|
||||||
|
|
||||||
getTimeLocale :: (MonadHandler m, HandlerSite m ~ UniWorX) => m TimeLocale
|
getTimeLocale :: (MonadHandler m, HandlerSite m ~ UniWorX) => m TimeLocale
|
||||||
getTimeLocale = getTimeLocale' <$> languages
|
getTimeLocale = getTimeLocale' <$> languages
|
||||||
|
|
||||||
@ -125,3 +132,10 @@ dateTimeFormatOptions sel = do
|
|||||||
return $ (dateTime, fmt)
|
return $ (dateTime, fmt)
|
||||||
|
|
||||||
optionsPairs <=< mapM toOption . Set.toList $ validDateTimeFormats tl sel
|
optionsPairs <=< mapM toOption . Set.toList $ validDateTimeFormats tl sel
|
||||||
|
|
||||||
|
|
||||||
|
addOneWeek :: UTCTime -> UTCTime
|
||||||
|
addOneWeek = addUTCTime (7 * nominalDay)
|
||||||
|
|
||||||
|
-- addOneTerm? -> Move Handler.Utils.DateTime
|
||||||
|
|
||||||
|
|||||||
99
src/Handler/Utils/Table/Cells.hs
Normal file
99
src/Handler/Utils/Table/Cells.hs
Normal file
@ -0,0 +1,99 @@
|
|||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# LANGUAGE PartialTypeSignatures #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
|
||||||
|
module Handler.Utils.Table.Cells where
|
||||||
|
|
||||||
|
import Import
|
||||||
|
|
||||||
|
import Data.Monoid (Any(..))
|
||||||
|
import Control.Monad.Writer.Class (MonadWriter(..))
|
||||||
|
|
||||||
|
import Utils.Lens
|
||||||
|
import Handler.Utils
|
||||||
|
|
||||||
|
|
||||||
|
type CourseLink = (TermId, SchoolId, CourseShorthand) -- TODO: Refactor with WithHoles !
|
||||||
|
|
||||||
|
--------------------
|
||||||
|
-- Special cells
|
||||||
|
|
||||||
|
indicatorCell :: IsDBTable m Any => DBCell m Any -- For dbTables that return a Bool to indicate content
|
||||||
|
indicatorCell = mempty & cellContents %~ (tell (Any True) *>)
|
||||||
|
|
||||||
|
-- Datatype cells
|
||||||
|
timeCell :: IsDBTable m a => UTCTime -> DBCell m a
|
||||||
|
timeCell t = cell $ formatTime SelFormatDateTime t >>= toWidget
|
||||||
|
|
||||||
|
userCell :: IsDBTable m a => Text -> Text -> DBCell m a
|
||||||
|
userCell displayName surname = cell $ nameWidget displayName surname
|
||||||
|
|
||||||
|
-- Just for documentation purposes; inline this code instead:
|
||||||
|
maybeTimeCell :: IsDBTable m a => Maybe UTCTime -> DBCell m a
|
||||||
|
maybeTimeCell = maybe mempty timeCell
|
||||||
|
|
||||||
|
termCell :: IsDBTable m a => TermId -> DBCell m a
|
||||||
|
termCell tid = anchorCell link name
|
||||||
|
where
|
||||||
|
link = TermCourseListR tid
|
||||||
|
name = text2widget $ display tid
|
||||||
|
|
||||||
|
termCellCL :: IsDBTable m a => CourseLink -> DBCell m a
|
||||||
|
termCellCL (tid,_,_) = termCell tid
|
||||||
|
|
||||||
|
schoolCell :: IsDBTable m a => Maybe TermId -> SchoolId -> DBCell m a
|
||||||
|
schoolCell (Just tid) ssh = anchorCell link name
|
||||||
|
where
|
||||||
|
link = TermSchoolCourseListR tid ssh
|
||||||
|
name = text2widget $ display ssh
|
||||||
|
schoolCell Nothing ssh = anchorCell link name
|
||||||
|
where
|
||||||
|
link = SchoolShowR ssh
|
||||||
|
name = text2widget $ display ssh
|
||||||
|
|
||||||
|
schoolCellCL :: IsDBTable m a => CourseLink -> DBCell m a
|
||||||
|
schoolCellCL (tid,ssh,_) = schoolCell (Just tid) ssh
|
||||||
|
|
||||||
|
courseCellCL :: IsDBTable m a => CourseLink -> DBCell m a
|
||||||
|
courseCellCL (tid,ssh,csh) = anchorCell link name
|
||||||
|
where
|
||||||
|
link = CourseR tid ssh csh CShowR
|
||||||
|
name = citext2widget csh
|
||||||
|
|
||||||
|
courseCell :: IsDBTable m a => Course -> DBCell m a
|
||||||
|
courseCell (Course {..}) = anchorCell link name `mappend` desc
|
||||||
|
where
|
||||||
|
link = CourseR courseTerm courseSchool courseShorthand CShowR
|
||||||
|
name = citext2widget courseName
|
||||||
|
desc = case courseDescription of
|
||||||
|
Nothing -> mempty
|
||||||
|
(Just descr) -> cell [whamlet| <span style="float:right"> ^{modalStatic descr} |]
|
||||||
|
|
||||||
|
sheetCell :: IsDBTable m a => CourseLink -> SheetName -> DBCell m a
|
||||||
|
sheetCell crse shn =
|
||||||
|
let tid = crse ^. _1
|
||||||
|
ssh = crse ^. _2
|
||||||
|
csh = crse ^. _3
|
||||||
|
link= CSheetR tid ssh csh shn SShowR
|
||||||
|
in anchorCell link $ display2widget shn
|
||||||
|
|
||||||
|
submissionCell :: IsDBTable m a => CourseLink -> SheetName -> SubmissionId -> DBCell m a
|
||||||
|
submissionCell crse shn sid =
|
||||||
|
let tid = crse ^. _1
|
||||||
|
ssh = crse ^. _2
|
||||||
|
csh = crse ^. _3
|
||||||
|
mkCid = encrypt sid
|
||||||
|
mkRoute cid = CSubmissionR tid ssh csh shn cid SubShowR
|
||||||
|
mkText cid = display2widget cid
|
||||||
|
in anchorCellM' mkCid mkRoute mkText
|
||||||
|
|
||||||
|
correctorStateCell :: IsDBTable m a => SheetCorrector -> DBCell m a
|
||||||
|
correctorStateCell sc =
|
||||||
|
i18nCell $ sheetCorrectorState sc
|
||||||
|
|
||||||
|
correctorLoadCell :: IsDBTable m a => SheetCorrector -> DBCell m a
|
||||||
|
correctorLoadCell sc =
|
||||||
|
i18nCell $ sheetCorrectorLoad sc
|
||||||
@ -21,7 +21,7 @@
|
|||||||
module Handler.Utils.Table.Pagination
|
module Handler.Utils.Table.Pagination
|
||||||
( SortColumn(..), SortDirection(..)
|
( SortColumn(..), SortDirection(..)
|
||||||
, FilterColumn(..), IsFilterColumn
|
, FilterColumn(..), IsFilterColumn
|
||||||
, DBRow(..), HasDBRow(..)
|
, DBRow(..), _dbrOutput, _dbrIndex, _dbrCount
|
||||||
, DBStyle(..), DBEmptyStyle(..)
|
, DBStyle(..), DBEmptyStyle(..)
|
||||||
, DBTable(..), IsDBTable(..), DBCell(..)
|
, DBTable(..), IsDBTable(..), DBCell(..)
|
||||||
, cellAttrs, cellContents
|
, cellAttrs, cellContents
|
||||||
@ -34,7 +34,7 @@ module Handler.Utils.Table.Pagination
|
|||||||
, dbTableWidget, dbTableWidget'
|
, dbTableWidget, dbTableWidget'
|
||||||
, widgetColonnade, formColonnade, dbColonnade
|
, widgetColonnade, formColonnade, dbColonnade
|
||||||
, cell, textCell, stringCell, i18nCell
|
, cell, textCell, stringCell, i18nCell
|
||||||
, anchorCell, anchorCell', anchorCellM
|
, anchorCell, anchorCell', anchorCellM, anchorCellM'
|
||||||
, tickmarkCell
|
, tickmarkCell
|
||||||
, listCell
|
, listCell
|
||||||
, formCell, DBFormResult, getDBFormResult
|
, formCell, DBFormResult, getDBFormResult
|
||||||
@ -45,6 +45,7 @@ module Handler.Utils.Table.Pagination
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Handler.Utils.Table.Pagination.Types
|
import Handler.Utils.Table.Pagination.Types
|
||||||
|
import Utils.Lens.TH
|
||||||
|
|
||||||
import Import hiding (Proxy(..))
|
import Import hiding (Proxy(..))
|
||||||
import qualified Database.Esqueleto as E
|
import qualified Database.Esqueleto as E
|
||||||
@ -134,7 +135,7 @@ data PaginationSettings = PaginationSettings
|
|||||||
, psShortcircuit :: Bool
|
, psShortcircuit :: Bool
|
||||||
}
|
}
|
||||||
|
|
||||||
makeClassy_ ''PaginationSettings
|
makeLenses_ ''PaginationSettings
|
||||||
|
|
||||||
instance Default PaginationSettings where
|
instance Default PaginationSettings where
|
||||||
def = PaginationSettings
|
def = PaginationSettings
|
||||||
@ -153,7 +154,7 @@ data PaginationInput = PaginationInput
|
|||||||
, piShortcircuit :: Bool
|
, piShortcircuit :: Bool
|
||||||
}
|
}
|
||||||
|
|
||||||
makeClassy_ ''PaginationInput
|
makeLenses_ ''PaginationInput
|
||||||
|
|
||||||
piIsUnset :: PaginationInput -> Bool
|
piIsUnset :: PaginationInput -> Bool
|
||||||
piIsUnset PaginationInput{..} = and
|
piIsUnset PaginationInput{..} = and
|
||||||
@ -169,7 +170,7 @@ data DBRow r = DBRow
|
|||||||
, dbrIndex, dbrCount :: Int64
|
, dbrIndex, dbrCount :: Int64
|
||||||
} deriving (Show, Read, Eq, Ord)
|
} deriving (Show, Read, Eq, Ord)
|
||||||
|
|
||||||
makeClassy_ ''DBRow
|
makeLenses_ ''DBRow
|
||||||
|
|
||||||
instance Functor DBRow where
|
instance Functor DBRow where
|
||||||
fmap f DBRow{..} = DBRow{ dbrOutput = f dbrOutput, .. }
|
fmap f DBRow{..} = DBRow{ dbrOutput = f dbrOutput, .. }
|
||||||
@ -485,10 +486,14 @@ dbColonnade = id
|
|||||||
cell :: IsDBTable m a => Widget -> DBCell m a
|
cell :: IsDBTable m a => Widget -> DBCell m a
|
||||||
cell wgt = dbCell # ([], return wgt)
|
cell wgt = dbCell # ([], return wgt)
|
||||||
|
|
||||||
textCell, stringCell, i18nCell :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
|
textCell, stringCell :: (MonoFoldable msg, Element msg ~ Char, IsDBTable m a) => msg -> DBCell m a
|
||||||
|
textCell = cell . toWidget . (pack :: [Char] -> Text) . otoList
|
||||||
stringCell = textCell
|
stringCell = textCell
|
||||||
i18nCell = textCell
|
|
||||||
textCell msg = cell [whamlet|_{msg}|]
|
i18nCell :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
|
||||||
|
i18nCell msg = cell $ do
|
||||||
|
mr <- getMessageRender
|
||||||
|
toWidget $ mr msg
|
||||||
|
|
||||||
tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a
|
tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a
|
||||||
tickmarkCell True = textCell (tickmark :: Text)
|
tickmarkCell True = textCell (tickmark :: Text)
|
||||||
@ -498,6 +503,7 @@ tickmarkCell False = mempty
|
|||||||
anchorCell :: IsDBTable m a => Route UniWorX -> Widget -> DBCell m a
|
anchorCell :: IsDBTable m a => Route UniWorX -> Widget -> DBCell m a
|
||||||
anchorCell = anchorCellM . return
|
anchorCell = anchorCellM . return
|
||||||
|
|
||||||
|
{-# DEPRECATED anchorCell' "For compatibility with Colonnade; better use anchorCell instead." #-}
|
||||||
anchorCell' :: IsDBTable m a
|
anchorCell' :: IsDBTable m a
|
||||||
=> (r -> Route UniWorX)
|
=> (r -> Route UniWorX)
|
||||||
-> (r -> Widget)
|
-> (r -> Widget)
|
||||||
@ -505,13 +511,18 @@ anchorCell' :: IsDBTable m a
|
|||||||
anchorCell' mkRoute mkWidget val = anchorCell (mkRoute val) (mkWidget val)
|
anchorCell' mkRoute mkWidget val = anchorCell (mkRoute val) (mkWidget val)
|
||||||
|
|
||||||
anchorCellM :: IsDBTable m a => (WidgetT UniWorX IO (Route UniWorX)) -> Widget -> DBCell m a
|
anchorCellM :: IsDBTable m a => (WidgetT UniWorX IO (Route UniWorX)) -> Widget -> DBCell m a
|
||||||
anchorCellM routeM widget = cell $ do
|
anchorCellM routeM widget = anchorCellM' routeM id (const widget)
|
||||||
route <- routeM
|
|
||||||
authResult <- liftHandlerT $ isAuthorized route False
|
anchorCellM' :: IsDBTable m a => (WidgetT UniWorX IO x) -> (x -> Route UniWorX) -> (x -> Widget) -> DBCell m a
|
||||||
|
anchorCellM' xM x2route x2widget = cell $ do
|
||||||
|
x <- xM
|
||||||
|
let route = x2route x
|
||||||
|
widget = x2widget x
|
||||||
|
authResult <- liftHandlerT $ isAuthorized route False
|
||||||
|
case authResult of
|
||||||
|
Authorized -> $(widgetFile "table/cell/link") -- show allowed link
|
||||||
|
_otherwise -> widget -- don't show prohibited link
|
||||||
|
|
||||||
if
|
|
||||||
| Authorized <- authResult -> $(widgetFile "table/cell/link")
|
|
||||||
| otherwise -> widget
|
|
||||||
|
|
||||||
listCell :: (IsDBTable m a, Traversable f) => f r' -> (r' -> DBCell m a) -> DBCell m a
|
listCell :: (IsDBTable m a, Traversable f) => f r' -> (r' -> DBCell m a) -> DBCell m a
|
||||||
listCell xs mkCell = review dbCell . ([], ) $ do
|
listCell xs mkCell = review dbCell . ([], ) $ do
|
||||||
@ -544,12 +555,12 @@ formCell genIndex genForm input = FormCell
|
|||||||
-- Predefined colonnades
|
-- Predefined colonnades
|
||||||
|
|
||||||
dbRow :: forall h r m a. (Headedness h, IsDBTable m a) => Colonnade h (DBRow r) (DBCell m a)
|
dbRow :: forall h r m a. (Headedness h, IsDBTable m a) => Colonnade h (DBRow r) (DBCell m a)
|
||||||
dbRow = Colonnade.singleton (headednessPure $ textCell MsgNrColumn) $ \DBRow{ dbrIndex } -> textCell $ tshow dbrIndex
|
dbRow = Colonnade.singleton (headednessPure $ i18nCell MsgNrColumn) $ \DBRow{ dbrIndex } -> textCell $ tshow dbrIndex
|
||||||
|
|
||||||
dbSelect :: forall h r i a. (Headedness h, Ord i, PathPiece i)
|
dbSelect :: forall h r i a. (Headedness h, Ord i, PathPiece i)
|
||||||
=> Setter' a Bool
|
=> Setter' a Bool
|
||||||
-> (r -> MForm (HandlerT UniWorX IO) i)
|
-> (r -> MForm (HandlerT UniWorX IO) i)
|
||||||
-> Colonnade h r (DBCell ((RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO))) (FormResult (DBFormResult r i a)))
|
-> Colonnade h r (DBCell ((RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO))) (FormResult (DBFormResult r i a)))
|
||||||
dbSelect resLens genIndex = Colonnade.singleton (headednessPure $ textCell MsgSelectColumn) $ \r -> flip (formCell genIndex) r $ \_ i -> do
|
dbSelect resLens genIndex = Colonnade.singleton (headednessPure $ i18nCell MsgSelectColumn) $ \r -> flip (formCell genIndex) r $ \_ i -> do
|
||||||
(selResult, selWidget) <- mreq checkBoxField ("" { fsName = Just $ "select-" <> toPathPiece i }) (Just False)
|
(selResult, selWidget) <- mreq checkBoxField ("" { fsName = Just $ "select-" <> toPathPiece i }) (Just False)
|
||||||
return (set resLens <$> selResult, [whamlet|^{fvInput selWidget}|])
|
return (set resLens <$> selResult, [whamlet|^{fvInput selWidget}|])
|
||||||
|
|||||||
@ -12,6 +12,8 @@ module Model.Migration
|
|||||||
|
|
||||||
import ClassyPrelude.Yesod
|
import ClassyPrelude.Yesod
|
||||||
|
|
||||||
|
import Utils (lastMaybe)
|
||||||
|
|
||||||
import Model
|
import Model
|
||||||
import Model.Migration.Version
|
import Model.Migration.Version
|
||||||
import Data.Map (Map)
|
import Data.Map (Map)
|
||||||
@ -23,6 +25,7 @@ import qualified Data.Set as Set
|
|||||||
import Database.Persist.Sql
|
import Database.Persist.Sql
|
||||||
import Database.Persist.Postgresql
|
import Database.Persist.Postgresql
|
||||||
|
|
||||||
|
import Text.Read (readMaybe)
|
||||||
import Data.CaseInsensitive (CI)
|
import Data.CaseInsensitive (CI)
|
||||||
|
|
||||||
-- Database versions must follow https://pvp.haskell.org:
|
-- Database versions must follow https://pvp.haskell.org:
|
||||||
@ -151,6 +154,26 @@ customMigrations = Map.fromListWith (>>)
|
|||||||
ALTER TABLE "school" ADD PRIMARY KEY (shorthand);
|
ALTER TABLE "school" ADD PRIMARY KEY (shorthand);
|
||||||
|]
|
|]
|
||||||
)
|
)
|
||||||
|
, ( AppliedMigrationKey [migrationVersion|2.0.0|] [version|3.0.0|]
|
||||||
|
, whenM (tableExists "sheet_corrector") $ do -- Load is encoded as JSON now.
|
||||||
|
correctorLoads <- [sqlQQ| SELECT "id", "load" FROM "sheet_corrector"; |]
|
||||||
|
forM_ correctorLoads $ \(uid, Single str) -> case readMaybe str of
|
||||||
|
Just load -> update uid [SheetCorrectorLoad =. load]
|
||||||
|
_other -> error $ "Could not parse Load: " <> show str
|
||||||
|
[executeQQ|
|
||||||
|
ALTER TABLE "sheet_corrector" ALTER COLUMN "load" TYPE json USING "load"::json;
|
||||||
|
|]
|
||||||
|
)
|
||||||
|
, ( AppliedMigrationKey [migrationVersion|3.0.0|] [version|3.1.0|]
|
||||||
|
, whenM (tableExists "user") $ do
|
||||||
|
userDisplayNames <- [sqlQQ| SELECT "id", "display_name" FROM "user"; |]
|
||||||
|
[executeQQ|
|
||||||
|
ALTER TABLE "user" ADD COLUMN "surname" text DEFAULT ' ';
|
||||||
|
|]
|
||||||
|
forM_ userDisplayNames $ \(uid, Single str) -> case lastMaybe $ words str of
|
||||||
|
Just name -> update uid [UserSurname =. name]
|
||||||
|
_other -> error $ "Empty userDisplayName found"
|
||||||
|
)
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@ -88,6 +88,8 @@ pToI = fromPoints
|
|||||||
fromPoints :: Integral a => Points -> a -- deprecated
|
fromPoints :: Integral a => Points -> a -- deprecated
|
||||||
fromPoints = round
|
fromPoints = round
|
||||||
|
|
||||||
|
instance DisplayAble Points
|
||||||
|
|
||||||
data SheetType
|
data SheetType
|
||||||
= Bonus { maxPoints :: Points }
|
= Bonus { maxPoints :: Points }
|
||||||
| Normal { maxPoints :: Points }
|
| Normal { maxPoints :: Points }
|
||||||
@ -201,7 +203,12 @@ data Load -- = ByTutorial { countsToLoad :: Bool } | ByProportion { load :: Rati
|
|||||||
, byProportion :: Rational -- ^ workload proportion of all submission not assigned to tutorial leaders
|
, byProportion :: Rational -- ^ workload proportion of all submission not assigned to tutorial leaders
|
||||||
}
|
}
|
||||||
deriving (Show, Read, Eq, Ord)
|
deriving (Show, Read, Eq, Ord)
|
||||||
derivePersistField "Load"
|
|
||||||
|
deriveJSON defaultOptions ''Load
|
||||||
|
derivePersistFieldJSON ''Load
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
instance Semigroup Load where
|
instance Semigroup Load where
|
||||||
(Load byTut prop) <> (Load byTut' prop') = Load byTut'' (prop + prop')
|
(Load byTut prop) <> (Load byTut' prop') = Load byTut'' (prop + prop')
|
||||||
@ -237,6 +244,8 @@ seasonFromChar c
|
|||||||
where
|
where
|
||||||
(~=) = (==) `on` CI.mk
|
(~=) = (==) `on` CI.mk
|
||||||
|
|
||||||
|
instance DisplayAble Season
|
||||||
|
|
||||||
data TermIdentifier = TermIdentifier
|
data TermIdentifier = TermIdentifier
|
||||||
{ year :: Integer -- ^ Using 'Integer' to model years is consistent with 'Data.Time.Calendar'
|
{ year :: Integer -- ^ Using 'Integer' to model years is consistent with 'Data.Time.Calendar'
|
||||||
, season :: Season
|
, season :: Season
|
||||||
@ -337,6 +346,8 @@ data StudyFieldType = FieldPrimary | FieldSecondary
|
|||||||
deriving (Eq, Ord, Enum, Show, Read, Bounded)
|
deriving (Eq, Ord, Enum, Show, Read, Bounded)
|
||||||
derivePersistField "StudyFieldType"
|
derivePersistField "StudyFieldType"
|
||||||
|
|
||||||
|
instance DisplayAble StudyFieldType
|
||||||
|
|
||||||
data Theme
|
data Theme
|
||||||
= ThemeDefault
|
= ThemeDefault
|
||||||
| ThemeLavender
|
| ThemeLavender
|
||||||
|
|||||||
90
src/Utils.hs
90
src/Utils.hs
@ -1,8 +1,9 @@
|
|||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE DefaultSignatures #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE RankNTypes #-}
|
{-# LANGUAGE RankNTypes #-}
|
||||||
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, UndecidableInstances #-}
|
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
|
||||||
{-# LANGUAGE TypeFamilies, FlexibleContexts, ConstraintKinds #-}
|
{-# LANGUAGE TypeFamilies, FlexibleContexts, ConstraintKinds #-}
|
||||||
{-# LANGUAGE QuasiQuotes, TemplateHaskell #-}
|
{-# LANGUAGE QuasiQuotes, TemplateHaskell #-}
|
||||||
{-# LANGUAGE ViewPatterns #-}
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
@ -15,7 +16,7 @@ module Utils
|
|||||||
import ClassyPrelude.Yesod
|
import ClassyPrelude.Yesod
|
||||||
|
|
||||||
-- import Data.Double.Conversion.Text -- faster implementation for textPercent?
|
-- import Data.Double.Conversion.Text -- faster implementation for textPercent?
|
||||||
import Data.Foldable as Fold
|
import Data.Foldable as Fold hiding (length)
|
||||||
|
|
||||||
import Data.CaseInsensitive (CI)
|
import Data.CaseInsensitive (CI)
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.CaseInsensitive as CI
|
||||||
@ -27,6 +28,11 @@ import Utils.PathPiece as Utils
|
|||||||
|
|
||||||
import Text.Blaze (Markup, ToMarkup)
|
import Text.Blaze (Markup, ToMarkup)
|
||||||
|
|
||||||
|
import Data.Char (isDigit)
|
||||||
|
import Data.Text (dropWhileEnd, takeWhileEnd, justifyRight)
|
||||||
|
import Numeric (showFFloat)
|
||||||
|
|
||||||
|
import Control.Lens
|
||||||
import Data.Set (Set)
|
import Data.Set (Set)
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import Data.Map (Map)
|
import Data.Map (Map)
|
||||||
@ -45,6 +51,8 @@ import Instances.TH.Lift ()
|
|||||||
|
|
||||||
import Text.Shakespeare.Text (st)
|
import Text.Shakespeare.Text (st)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-----------
|
-----------
|
||||||
-- Yesod --
|
-- Yesod --
|
||||||
-----------
|
-----------
|
||||||
@ -80,6 +88,7 @@ unsupportedAuthPredicate = do
|
|||||||
|]
|
|]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
---------------------
|
---------------------
|
||||||
-- Text and String --
|
-- Text and String --
|
||||||
---------------------
|
---------------------
|
||||||
@ -112,15 +121,21 @@ str2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m) =>
|
|||||||
String -> WidgetT site m ()
|
String -> WidgetT site m ()
|
||||||
str2widget s = [whamlet|#{s}|]
|
str2widget s = [whamlet|#{s}|]
|
||||||
|
|
||||||
|
display2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m, DisplayAble a) =>
|
||||||
|
a -> WidgetT site m ()
|
||||||
|
display2widget = text2widget . display
|
||||||
|
|
||||||
withFragment :: ( Monad m
|
withFragment :: Monad m => MForm m (a, WidgetT site IO ()) -> Markup -> MForm m (a, WidgetT site IO ())
|
||||||
) => MForm m (a, WidgetT site IO ()) -> Markup -> MForm m (a, WidgetT site IO ())
|
|
||||||
withFragment form html = (flip fmap) form $ \(x, widget) -> (x, toWidget html >> widget)
|
withFragment form html = (flip fmap) form $ \(x, widget) -> (x, toWidget html >> widget)
|
||||||
|
|
||||||
|
|
||||||
-- Convert anything to Text, and I don't care how
|
-- Types that can be converted to Text for direct displayed to User! (Show for debugging, Display for Production)
|
||||||
|
{-# DEPRECATED display "Create RenderMessage Instances instead!" #-}
|
||||||
class DisplayAble a where
|
class DisplayAble a where
|
||||||
display :: a -> Text
|
display :: a -> Text
|
||||||
|
-- Default definitions for types belonging to Show (allows empty instance declarations)
|
||||||
|
default display :: Show a => a -> Text
|
||||||
|
display = pack . show
|
||||||
|
|
||||||
instance DisplayAble Text where
|
instance DisplayAble Text where
|
||||||
display = id
|
display = id
|
||||||
@ -128,6 +143,19 @@ instance DisplayAble Text where
|
|||||||
instance DisplayAble String where
|
instance DisplayAble String where
|
||||||
display = pack
|
display = pack
|
||||||
|
|
||||||
|
instance DisplayAble Int
|
||||||
|
instance DisplayAble Int64
|
||||||
|
instance DisplayAble Integer
|
||||||
|
|
||||||
|
instance DisplayAble Rational where
|
||||||
|
display r = showFFloat (Just 2) (rat2float r) ""
|
||||||
|
& pack
|
||||||
|
& dropWhileEnd ('0'==)
|
||||||
|
& dropWhileEnd ('.'==)
|
||||||
|
where
|
||||||
|
rat2float :: Rational -> Double
|
||||||
|
rat2float = fromRational
|
||||||
|
|
||||||
instance DisplayAble a => DisplayAble (Maybe a) where
|
instance DisplayAble a => DisplayAble (Maybe a) where
|
||||||
display Nothing = ""
|
display Nothing = ""
|
||||||
display (Just x) = display x
|
display (Just x) = display x
|
||||||
@ -138,9 +166,12 @@ instance DisplayAble a => DisplayAble (E.Value a) where
|
|||||||
instance DisplayAble a => DisplayAble (CI a) where
|
instance DisplayAble a => DisplayAble (CI a) where
|
||||||
display = display . CI.original
|
display = display . CI.original
|
||||||
|
|
||||||
-- The easy way out of UndecidableInstances (TypeFamilies would have been proper, but are much more complicated)
|
{- We do not want DisplayAble for every Show-Class:
|
||||||
instance {-# OVERLAPPABLE #-} Show a => DisplayAble a where
|
We want to explicitly verify that the resulting text can be displayed to the User!
|
||||||
|
For example: UTCTime values were shown without proper format rendering!
|
||||||
|
instance {-# OVERLAPPABLE #-} Show a => DisplayAble a where -- The easy way out of UndecidableInstances (TypeFamilies would have been proper, but are much more complicated)
|
||||||
display = pack . show
|
display = pack . show
|
||||||
|
-}
|
||||||
|
|
||||||
textPercent :: Double -> Text -- slow, maybe use Data.Double.Conversion.Text.toFixed instead?
|
textPercent :: Double -> Text -- slow, maybe use Data.Double.Conversion.Text.toFixed instead?
|
||||||
textPercent x = lz <> (pack $ show rx) <> "%"
|
textPercent x = lz <> (pack $ show rx) <> "%"
|
||||||
@ -151,6 +182,24 @@ textPercent x = lz <> (pack $ show rx) <> "%"
|
|||||||
rx = fromIntegral (round' $ 1000.0*x) / 10.0
|
rx = fromIntegral (round' $ 1000.0*x) / 10.0
|
||||||
lz = if rx < 10.0 then "0" else ""
|
lz = if rx < 10.0 then "0" else ""
|
||||||
|
|
||||||
|
stepTextCounterCI :: CI Text -> CI Text -- find and increment rightmost-number, preserving leading zeroes
|
||||||
|
stepTextCounterCI = CI.map stepTextCounter
|
||||||
|
|
||||||
|
stepTextCounter :: Text -> Text -- find and increment rightmost-number, preserving leading zeroes
|
||||||
|
stepTextCounter text
|
||||||
|
| (Just i) <- readMay number =
|
||||||
|
let iplus1 = tshow (succ i :: Int)
|
||||||
|
zeroip = justifyRight (length number) '0' iplus1
|
||||||
|
in prefix <> zeroip <> suffix
|
||||||
|
| otherwise = text
|
||||||
|
where -- no splitWhile nor findEnd in Data.Text
|
||||||
|
suffix = takeWhileEnd (not . isDigit) text
|
||||||
|
number = takeWhileEnd isDigit $ dropWhileEnd (not . isDigit) text
|
||||||
|
prefix = dropWhileEnd isDigit $ dropWhileEnd (not . isDigit) text
|
||||||
|
|
||||||
|
-- Data.Text.groupBy ((==) `on` isDigit) $ Data.Text.pack "12.ProMo Ue3bung00322 34 (H)"
|
||||||
|
-- ["12",".ProMo Ue","3","bung","00322"," ","34"," (H)"]
|
||||||
|
|
||||||
|
|
||||||
------------
|
------------
|
||||||
-- Tuples --
|
-- Tuples --
|
||||||
@ -168,12 +217,22 @@ trd3 (_,_,z) = z
|
|||||||
-- snd3 = $(projNI 3 2)
|
-- snd3 = $(projNI 3 2)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-----------
|
-----------
|
||||||
-- Lists --
|
-- Lists --
|
||||||
-----------
|
-----------
|
||||||
|
|
||||||
-- notNull = not . null
|
-- notNull = not . null
|
||||||
|
|
||||||
|
lastMaybe :: [a] -> Maybe a
|
||||||
|
lastMaybe [] = Nothing
|
||||||
|
lastMaybe [h] = Just h
|
||||||
|
lastMaybe (_:t) = lastMaybe t
|
||||||
|
|
||||||
|
lastMaybe' :: [a] -> Maybe a
|
||||||
|
lastMaybe' l = fmap snd $ l ^? _Snoc
|
||||||
|
|
||||||
|
|
||||||
mergeAttrs :: [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
|
mergeAttrs :: [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
|
||||||
mergeAttrs = mergeAttrs' `on` sort
|
mergeAttrs = mergeAttrs' `on` sort
|
||||||
where
|
where
|
||||||
@ -191,6 +250,8 @@ mergeAttrs = mergeAttrs' `on` sort
|
|||||||
mergeAttrs' [] xs2 = xs2
|
mergeAttrs' [] xs2 = xs2
|
||||||
mergeAttrs' xs1 [] = xs1
|
mergeAttrs' xs1 [] = xs1
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
----------
|
----------
|
||||||
-- Maps --
|
-- Maps --
|
||||||
----------
|
----------
|
||||||
@ -210,6 +271,8 @@ partMap = Map.fromListWith mappend
|
|||||||
invertMap :: (Ord k, Ord v) => Map k v -> Map v (Set k)
|
invertMap :: (Ord k, Ord v) => Map k v -> Map v (Set k)
|
||||||
invertMap = groupMap . map swap . Map.toList
|
invertMap = groupMap . map swap . Map.toList
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-----------
|
-----------
|
||||||
-- Maybe --
|
-- Maybe --
|
||||||
-----------
|
-----------
|
||||||
@ -218,6 +281,12 @@ toMaybe :: Bool -> a -> Maybe a
|
|||||||
toMaybe True = Just
|
toMaybe True = Just
|
||||||
toMaybe False = const Nothing
|
toMaybe False = const Nothing
|
||||||
|
|
||||||
|
toNothing :: a -> Maybe b
|
||||||
|
toNothing = const Nothing
|
||||||
|
|
||||||
|
toNothingS :: String -> Maybe b
|
||||||
|
toNothingS = const Nothing
|
||||||
|
|
||||||
maybeAdd :: Num a => Maybe a -> Maybe a -> Maybe a -- treats Nothing as neutral/zero, unlike fmap
|
maybeAdd :: Num a => Maybe a -> Maybe a -> Maybe a -- treats Nothing as neutral/zero, unlike fmap
|
||||||
maybeAdd (Just x) (Just y) = Just (x + y)
|
maybeAdd (Just x) (Just y) = Just (x + y)
|
||||||
maybeAdd Nothing y = y
|
maybeAdd Nothing y = y
|
||||||
@ -252,6 +321,8 @@ instance Ord a => Ord (NTop (Maybe a)) where
|
|||||||
compare _ (NTop Nothing) = LT
|
compare _ (NTop Nothing) = LT
|
||||||
compare (NTop (Just x)) (NTop (Just y)) = compare x y
|
compare (NTop (Just x)) (NTop (Just y)) = compare x y
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
---------------
|
---------------
|
||||||
-- Exception --
|
-- Exception --
|
||||||
---------------
|
---------------
|
||||||
@ -281,16 +352,17 @@ catchIfMExceptT :: (MonadCatch m, Exception e) => (e -> m e') -> (e -> Bool) ->
|
|||||||
catchIfMExceptT err p act = catchIf p (lift act) (throwE <=< lift . err)
|
catchIfMExceptT err p act = catchIf p (lift act) (throwE <=< lift . err)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
------------
|
------------
|
||||||
-- Monads --
|
-- Monads --
|
||||||
------------
|
------------
|
||||||
|
|
||||||
shortCircuitM :: Monad m => (a -> Bool) -> m a -> m a -> (a -> a -> a) -> m a
|
shortCircuitM :: Monad m => (a -> Bool) -> m a -> m a -> (a -> a -> a) -> m a
|
||||||
shortCircuitM sc mx my op = do
|
shortCircuitM sc mx my bop = do
|
||||||
x <- mx
|
x <- mx
|
||||||
case sc x of
|
case sc x of
|
||||||
True -> return x
|
True -> return x
|
||||||
False -> op <$> pure x <*> my
|
False -> bop <$> pure x <*> my
|
||||||
|
|
||||||
|
|
||||||
guardM :: MonadPlus m => m Bool -> m ()
|
guardM :: MonadPlus m => m Bool -> m ()
|
||||||
|
|||||||
@ -10,10 +10,20 @@ import ClassyPrelude.Yesod
|
|||||||
import qualified Data.List as List
|
import qualified Data.List as List
|
||||||
import Data.Map (Map)
|
import Data.Map (Map)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
import Data.Set (Set)
|
||||||
|
import qualified Data.Set as Set
|
||||||
|
import qualified Database.Esqueleto as E
|
||||||
-- import Database.Persist -- currently not needed here
|
-- import Database.Persist -- currently not needed here
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
emptyOrIn :: PersistField typ =>
|
||||||
|
E.SqlExpr (E.Value typ) -> Set typ -> E.SqlExpr (E.Value Bool)
|
||||||
|
emptyOrIn criterion testSet
|
||||||
|
| Set.null testSet = E.val True
|
||||||
|
| otherwise = criterion `E.in_` E.valList (Set.toList testSet)
|
||||||
|
|
||||||
|
|
||||||
entities2map :: PersistEntity record => [Entity record] -> Map (Key record) record
|
entities2map :: PersistEntity record => [Entity record] -> Map (Key record) record
|
||||||
entities2map = foldl' (\m entity -> Map.insert (entityKey entity) (entityVal entity) m) Map.empty
|
entities2map = foldl' (\m entity -> Map.insert (entityKey entity) (entityVal entity) m) Map.empty
|
||||||
|
|
||||||
|
|||||||
@ -28,6 +28,7 @@ import Instances.TH.Lift ()
|
|||||||
deriving instance Lift TimeZone
|
deriving instance Lift TimeZone
|
||||||
deriving instance Lift TimeLocale
|
deriving instance Lift TimeLocale
|
||||||
|
|
||||||
|
|
||||||
-- $(timeLocaleMap _) :: [Lang] -> TimeLocale
|
-- $(timeLocaleMap _) :: [Lang] -> TimeLocale
|
||||||
timeLocaleMap :: [(Lang, String)] -- ^ Languages and matching locales, first is taken as default
|
timeLocaleMap :: [(Lang, String)] -- ^ Languages and matching locales, first is taken as default
|
||||||
-> ExpQ
|
-> ExpQ
|
||||||
|
|||||||
@ -7,9 +7,28 @@ module Utils.Lens ( module Utils.Lens ) where
|
|||||||
|
|
||||||
import Import.NoFoundation
|
import Import.NoFoundation
|
||||||
import Control.Lens as Utils.Lens
|
import Control.Lens as Utils.Lens
|
||||||
|
import Utils.Lens.TH
|
||||||
|
|
||||||
makeClassy_ ''Entity
|
import qualified Database.Esqueleto as E (Value(..),InnerJoin(..))
|
||||||
|
|
||||||
makeClassy_ ''SheetCorrector
|
_unValue :: Lens' (E.Value a) a
|
||||||
|
_unValue f (E.Value a) = E.Value <$> f a
|
||||||
|
|
||||||
|
_InnerJoinLeft :: Lens' (E.InnerJoin l r) l -- forall f. Functor f => (a -> f a) -> s -> f s
|
||||||
|
_InnerJoinLeft f (E.InnerJoin l r) = (`E.InnerJoin` r) <$> f l
|
||||||
|
|
||||||
|
_InnerJoinRight :: Lens' (E.InnerJoin l r) r
|
||||||
|
_InnerJoinRight f (E.InnerJoin l r) = (l `E.InnerJoin`) <$> f r
|
||||||
|
|
||||||
|
|
||||||
|
makeLenses_ ''Entity
|
||||||
|
|
||||||
|
makeLenses_ ''Course
|
||||||
|
|
||||||
|
makeLenses_ ''SheetCorrector
|
||||||
|
|
||||||
|
makeLenses_ ''SubmissionGroup
|
||||||
|
|
||||||
-- makeClassy_ ''Load
|
-- makeClassy_ ''Load
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
47
src/Utils/Lens/TH.hs
Normal file
47
src/Utils/Lens/TH.hs
Normal file
@ -0,0 +1,47 @@
|
|||||||
|
module Utils.Lens.TH where
|
||||||
|
|
||||||
|
import Control.Lens
|
||||||
|
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,
|
||||||
|
which was currently unavailable in our stack snapshot.
|
||||||
|
See https://github.com/louispan/lens-misc
|
||||||
|
-}
|
||||||
|
|
||||||
|
-- | A 'LensRules' used by 'makeLenses_'.
|
||||||
|
lensRules_ :: LensRules
|
||||||
|
lensRules_ = lensRules
|
||||||
|
& lensField .~ \_ _ n -> [TopName (mkName ('_':nameBase n))]
|
||||||
|
|
||||||
|
-- | Build lenses (and traversals) with a sensible default configuration.
|
||||||
|
-- Works the same as 'makeLenses' except that
|
||||||
|
-- the resulting lens is also prefixed with an underscore.
|
||||||
|
--
|
||||||
|
-- /e.g./
|
||||||
|
--
|
||||||
|
-- @
|
||||||
|
-- data FooBar
|
||||||
|
-- = Foo { x, y :: 'Int' }
|
||||||
|
-- | Bar { x :: 'Int' }
|
||||||
|
-- 'makeLenses' ''FooBar
|
||||||
|
-- @
|
||||||
|
--
|
||||||
|
-- will create
|
||||||
|
--
|
||||||
|
-- @
|
||||||
|
-- _x :: 'Lens'' FooBar 'Int'
|
||||||
|
-- _x f (Foo a b) = (\\a\' -> Foo a\' b) \<$\> f a
|
||||||
|
-- _x f (Bar a) = Bar \<$\> f a
|
||||||
|
-- _y :: 'Traversal'' FooBar 'Int'
|
||||||
|
-- _y f (Foo a b) = (\\b\' -> Foo a b\') \<$\> f b
|
||||||
|
-- _y _ c\@(Bar _) = pure c
|
||||||
|
-- @
|
||||||
|
--
|
||||||
|
-- @
|
||||||
|
-- 'makeLenses_' = 'makeLensesWith' 'lensRules_'
|
||||||
|
-- @
|
||||||
|
|
||||||
|
makeLenses_ :: Name -> DecsQ
|
||||||
|
makeLenses_ = makeFieldOptics lensRules_
|
||||||
@ -38,14 +38,14 @@ nullaryToPathPiece nullaryType manglers = do
|
|||||||
splitCamel :: Text -> [Text]
|
splitCamel :: Text -> [Text]
|
||||||
splitCamel = map Text.pack . reverse . helper (error "hasChange undefined at start of string") [] "" . Text.unpack
|
splitCamel = map Text.pack . reverse . helper (error "hasChange undefined at start of string") [] "" . Text.unpack
|
||||||
where
|
where
|
||||||
helper hadChange words thisWord [] = reverse thisWord : words
|
helper _hadChange items thisWord [] = reverse thisWord : items
|
||||||
helper hadChange words [] (c:cs) = helper True words [c] cs
|
helper _hadChange items [] (c:cs) = helper True items [c] cs
|
||||||
helper hadChange words ws@(w:ws') (c:cs)
|
helper hadChange items ws@(w:ws') (c:cs)
|
||||||
| sameCategory w c
|
| sameCategory w c
|
||||||
, null ws' = helper False words (c:ws) cs
|
, null ws' = helper False items (c:ws) cs
|
||||||
| sameCategory w c = helper hadChange words (c:ws) cs
|
| sameCategory w c = helper hadChange items (c:ws) cs
|
||||||
| null ws' = helper True words (c:ws) cs
|
| null ws' = helper True items (c:ws) cs
|
||||||
| not hadChange = helper True (reverse ws':words) [c,w] cs
|
| not hadChange = helper True (reverse ws':items) [c,w] cs
|
||||||
| otherwise = helper True (reverse ws:words) [c] cs
|
| otherwise = helper True (reverse ws :items) [c] cs
|
||||||
|
|
||||||
sameCategory = (==) `on` Char.generalCategory
|
sameCategory = (==) `on` Char.generalCategory
|
||||||
|
|||||||
@ -17,14 +17,12 @@ import Language.Haskell.TH
|
|||||||
------------
|
------------
|
||||||
|
|
||||||
-- Alternatively uses lenses: "^. _3" projects the 3rd component of an n-tuple for any n >=3, requires import Control.Lens
|
-- Alternatively uses lenses: "^. _3" projects the 3rd component of an n-tuple for any n >=3, requires import Control.Lens
|
||||||
{-
|
|
||||||
projNI :: Int -> Int -> ExpQ -- generic projection gives I-th element of N-tuple, i.e. snd3 = $(projNI 3 2) --ghci -fth
|
projNI :: Int -> Int -> ExpQ -- generic projection gives I-th element of N-tuple, i.e. snd3 = $(projNI 3 2) --ghci -fth
|
||||||
-- $(projN n m) :: (t1,..,tn) -> tm (for m<=n)
|
-- $(projN n m) :: (t1,..,tn) -> tm (for m<=n)
|
||||||
projNI n i = lamE [pat] rhs
|
projNI n i = lamE [pat] rhs
|
||||||
where pat = tupP (map varP xs)
|
where pat = tupP (map varP xs)
|
||||||
rhs = varE (xs !! (i - 1))
|
rhs = varE (xs !! (i - 1))
|
||||||
xs = [ mkName $ "x" ++ show j | j <- [1..n] ]
|
xs = [ mkName $ "x" ++ show j | j <- [1..n] ]
|
||||||
-}
|
|
||||||
|
|
||||||
---------------
|
---------------
|
||||||
-- Functions --
|
-- Functions --
|
||||||
|
|||||||
@ -74,7 +74,10 @@ Handler.Utils.Table.Pagination
|
|||||||
|
|
||||||
Handler.Utils.Table.Pagination.Types
|
Handler.Utils.Table.Pagination.Types
|
||||||
: `Sortable`-Headedness for colonnade
|
: `Sortable`-Headedness for colonnade
|
||||||
|
|
||||||
|
Handler.Utils.Table.Cells
|
||||||
|
: extends dbTable with UniWorX specific functions, such as special courseCell
|
||||||
|
|
||||||
Handler.Utils.Templates
|
Handler.Utils.Templates
|
||||||
: Modals
|
: Modals
|
||||||
|
|
||||||
|
|||||||
@ -1,39 +1,39 @@
|
|||||||
<div .scrolltable>
|
<div .scrolltable>
|
||||||
<table .table .table--striped .table--hover .table--vertical>
|
<table .table .table--striped .table--hover .table--vertical>
|
||||||
<tr .table__row>
|
<tr .table__row>
|
||||||
<th .table__th> _{MsgSubmission}
|
<th .table__th>_{MsgSubmission}
|
||||||
<td .table__td> #{display cid}
|
<td .table__td>#{display cid}
|
||||||
$maybe Entity _ User{..} <- corrector
|
$maybe Entity _ User{..} <- corrector
|
||||||
<tr .table__row>
|
<tr .table__row>
|
||||||
<th .table__th> _{MsgRatingBy}
|
<th .table__th>_{MsgRatingBy}
|
||||||
<td .table__td> #{display userDisplayName}
|
<td .table__td>#{display userDisplayName}
|
||||||
$maybe time <- submissionRatingTime
|
$maybe time <- submissionRatingTime
|
||||||
<tr .table__row>
|
<tr .table__row>
|
||||||
<th .table__th> _{MsgRatingTime}
|
<th .table__th>_{MsgRatingTime}
|
||||||
<td .table__td> #{display time}
|
<td .table__td>^{formatTimeW SelFormatDateTime time}
|
||||||
$maybe points <- submissionRatingPoints
|
$maybe points <- submissionRatingPoints
|
||||||
$case sheetType
|
$case sheetType
|
||||||
$of Bonus{..}
|
$of Bonus{..}
|
||||||
<tr .table__row>
|
<tr .table__row>
|
||||||
<th .table__th> _{MsgAchievedBonusPoints}
|
<th .table__th>_{MsgAchievedBonusPoints}
|
||||||
<td .table__td> _{MsgAchievedOf points maxPoints}
|
<td .table__td>_{MsgAchievedOf points maxPoints}
|
||||||
$of Normal{..}
|
$of Normal{..}
|
||||||
<tr .table__row>
|
<tr .table__row>
|
||||||
<th .table__th> _{MsgAchievedNormalPoints}
|
<th .table__th>_{MsgAchievedNormalPoints}
|
||||||
<td .table__td> _{MsgAchievedOf points maxPoints}
|
<td .table__td>_{MsgAchievedOf points maxPoints}
|
||||||
$of Pass{..}
|
$of Pass{..}
|
||||||
<tr .table__row>
|
<tr .table__row>
|
||||||
<th .table__th> _{MsgPassedResult}
|
<th .table__th>_{MsgPassedResult}
|
||||||
<td .table__td>
|
<td .table__td>
|
||||||
$if points >= passingPoints
|
$if points >= passingPoints
|
||||||
_{MsgPassed}
|
_{MsgPassed}
|
||||||
$else
|
$else
|
||||||
_{MsgNotPassed}
|
_{MsgNotPassed}
|
||||||
<tr .table__row>
|
<tr .table__row>
|
||||||
<th .table__th> _{MsgAchievedPassPoints}
|
<th .table__th>_{MsgAchievedPassPoints}
|
||||||
<td .table__td> _{MsgPassAchievedOf points passingPoints maxPoints}
|
<td .table__td>_{MsgPassAchievedOf points passingPoints maxPoints}
|
||||||
$of NotGraded
|
$of NotGraded
|
||||||
$maybe comment <- ratingComment
|
$maybe comment <- ratingComment
|
||||||
<tr .table__row>
|
<tr .table__row>
|
||||||
<th .table__th> _{MsgRatingComment}
|
<th .table__th>_{MsgRatingComment}
|
||||||
<td .table__td style="white-space: pre;"> #{comment}
|
<td .table__td style="white-space: pre;">#{comment}
|
||||||
|
|||||||
@ -5,11 +5,22 @@
|
|||||||
<dd .deflist__dd>
|
<dd .deflist__dd>
|
||||||
<div>
|
<div>
|
||||||
#{schoolName school}
|
#{schoolName school}
|
||||||
|
|
||||||
$maybe descr <- courseDescription course
|
$maybe descr <- courseDescription course
|
||||||
<dt .deflist__dt>_{MsgCourseDescription}
|
<dt .deflist__dt>_{MsgCourseDescription}
|
||||||
<dd .deflist__dd>
|
<dd .deflist__dd>
|
||||||
<div>
|
<div>
|
||||||
#{descr}
|
#{descr}
|
||||||
|
|
||||||
|
$with numlecs <- length lecturers
|
||||||
|
$if numlecs > 1
|
||||||
|
<dt .deflist__dt>_{MsgLecturersFor}
|
||||||
|
$else
|
||||||
|
<dt .deflist__dt>_{MsgLecturerFor}
|
||||||
|
<dd .deflist__dd>
|
||||||
|
<div>
|
||||||
|
#{T.intercalate ", " lecturers}
|
||||||
|
|
||||||
$maybe link <- courseLinkExternal course
|
$maybe link <- courseLinkExternal course
|
||||||
<dt .deflist__dt>Website
|
<dt .deflist__dt>Website
|
||||||
<dd .deflist__dd>
|
<dd .deflist__dd>
|
||||||
|
|||||||
@ -15,6 +15,8 @@
|
|||||||
<div .main__content-body>
|
<div .main__content-body>
|
||||||
|
|
||||||
<h1>
|
<h1>
|
||||||
|
<!-- $maybe back <- lastMaybe parents
|
||||||
|
<a .breadcrumbs__link href="@{fst back}">#{snd back} -->
|
||||||
$maybe headline <- contentHeadline
|
$maybe headline <- contentHeadline
|
||||||
^{headline}
|
^{headline}
|
||||||
$nothing
|
$nothing
|
||||||
|
|||||||
@ -1,7 +1,7 @@
|
|||||||
:root {
|
:root {
|
||||||
/* THEME INDEPENDENT COLORS */
|
/* THEME INDEPENDENT COLORS */
|
||||||
--color-error: #ff3860;
|
--color-error: #8c0707;
|
||||||
--color-warning: #ffdd57;
|
--color-warning: #fc9900;
|
||||||
--color-success: #23d160;
|
--color-success: #23d160;
|
||||||
--color-info: #c4c4c4;
|
--color-info: #c4c4c4;
|
||||||
--color-lightblack: #1A2A36;
|
--color-lightblack: #1A2A36;
|
||||||
|
|||||||
@ -14,4 +14,3 @@
|
|||||||
Bitte melden Sie etwaige Probleme an #
|
Bitte melden Sie etwaige Probleme an #
|
||||||
<a href="mailto:jost@tcs.ifi.lmu.de">
|
<a href="mailto:jost@tcs.ifi.lmu.de">
|
||||||
jost@tcs.ifi.lmu.de
|
jost@tcs.ifi.lmu.de
|
||||||
|
|
||||||
|
|||||||
@ -3,10 +3,9 @@
|
|||||||
border-radius: 3px;
|
border-radius: 3px;
|
||||||
padding: 10px 20px 20px;
|
padding: 10px 20px 20px;
|
||||||
margin: 40px 0;
|
margin: 40px 0;
|
||||||
color: var(--color-lighter);
|
color: var(--color-dark);
|
||||||
box-shadow: 0 0 4px 2px inset currentColor;
|
box-shadow: 0 0 4px 2px inset currentColor;
|
||||||
padding-left: 20%;
|
padding-left: 20%;
|
||||||
color: #318dc5 ;
|
|
||||||
|
|
||||||
&::before {
|
&::before {
|
||||||
content: 'i';
|
content: 'i';
|
||||||
|
|||||||
@ -59,10 +59,10 @@
|
|||||||
<dt .deflist__dt> Teilnehmer
|
<dt .deflist__dt> Teilnehmer
|
||||||
<dd .deflist__dd>
|
<dd .deflist__dd>
|
||||||
<dl .deflist>
|
<dl .deflist>
|
||||||
$forall (E.Value tid, E.Value ssh, E.Value csh, regSince) <- participant
|
$forall (E.Value tid, E.Value ssh, E.Value csh, E.Value regSince) <- participant
|
||||||
<dt .deflist__dt>
|
<dt .deflist__dt>
|
||||||
<a href=@{CourseR tid ssh csh CShowR}>#{display tid}-#{display ssh}-#{display csh}
|
<a href=@{CourseR tid ssh csh CShowR}>#{display tid}-#{display ssh}-#{display csh}
|
||||||
<dd .deflist__dd>
|
<dd .deflist__dd>
|
||||||
seit #{display regSince}
|
seit ^{formatTimeW SelFormatDateTime regSince}
|
||||||
|
|
||||||
^{settingsForm}
|
^{settingsForm}
|
||||||
|
|||||||
@ -8,10 +8,44 @@
|
|||||||
|
|
||||||
<em> TODO: Hier alle Daten in Tabellen anzeigen!
|
<em> TODO: Hier alle Daten in Tabellen anzeigen!
|
||||||
|
|
||||||
|
$if hasRows
|
||||||
|
<div .container>
|
||||||
|
<h2> Eigene Kurse
|
||||||
|
<div .container>
|
||||||
|
^{ownedCoursesTable}
|
||||||
|
|
||||||
<div .container>
|
<div .container>
|
||||||
<h2> Kursanmeldungen
|
<h2> Kursanmeldungen
|
||||||
<div .container>
|
<div .container>
|
||||||
^{courseTable}
|
^{enrolledCoursesTable}
|
||||||
|
|
||||||
|
<div .container>
|
||||||
|
<h2> Noten
|
||||||
|
<div .container>
|
||||||
|
^{examTable}
|
||||||
|
|
||||||
|
<div .container>
|
||||||
|
<h2> Übungsgruppen
|
||||||
|
<div .container>
|
||||||
|
^{tutorialTable}
|
||||||
|
|
||||||
|
<div .container>
|
||||||
|
<h2> Abgabegruppen
|
||||||
|
<div .container>
|
||||||
|
^{submissionGroupTable}
|
||||||
|
|
||||||
|
<div .container>
|
||||||
|
<h2> Abgaben
|
||||||
|
<div .container>
|
||||||
|
^{submissionTable}
|
||||||
|
<em>Hinweis:
|
||||||
|
Bei Gruppenabgaben wird kein Datum angezeigt,
|
||||||
|
falls Sie die Gruppenabgabe nie selbst hochgeladen haben.
|
||||||
|
|
||||||
|
<div .container>
|
||||||
|
<h2> _{MsgCorrector}
|
||||||
|
<div .container>
|
||||||
|
^{correctionsTable}
|
||||||
|
|
||||||
<h2>
|
<h2>
|
||||||
<em> TODO: Knopf zum Löschen aller Daten erstellen
|
<em> TODO: Knopf zum Löschen aller Daten erstellen
|
||||||
|
|||||||
@ -6,7 +6,7 @@
|
|||||||
window.utils.alert = function(alertEl) {
|
window.utils.alert = function(alertEl) {
|
||||||
var closeEl = document.createElement('DIV');
|
var closeEl = document.createElement('DIV');
|
||||||
var dataDecay = alertEl.dataset.decay;
|
var dataDecay = alertEl.dataset.decay;
|
||||||
var autoDecay = 3;
|
var autoDecay = 30;
|
||||||
if (dataDecay) {
|
if (dataDecay) {
|
||||||
autoDecay = parseInt(dataDecay, 10);
|
autoDecay = parseInt(dataDecay, 10);
|
||||||
}
|
}
|
||||||
|
|||||||
@ -2,13 +2,13 @@
|
|||||||
/**
|
/**
|
||||||
.alert
|
.alert
|
||||||
Regular Info Alert
|
Regular Info Alert
|
||||||
Disappears automatically after 3 seconds
|
Disappears automatically after 30 seconds
|
||||||
Disappears after x seconds if sepcified via data-decay='x'
|
Disappears after x seconds if explicitly specified via data-decay='x' on html element
|
||||||
Can be told not to disappear with data-decay='0'
|
Can be told not to disappear with data-decay='0'
|
||||||
|
|
||||||
.alert-warning, .alert-error
|
.alert-warning, .alert-error
|
||||||
Warning or Error alert
|
Warning or Error alert
|
||||||
Don't disappear, only difference is color
|
These don't disappear, only difference is color
|
||||||
.alert-warning is orange regardless of user's selected theme
|
.alert-warning is orange regardless of user's selected theme
|
||||||
.alert-error is red regardless of user's selected theme
|
.alert-error is red regardless of user's selected theme
|
||||||
|
|
||||||
@ -23,20 +23,12 @@
|
|||||||
flex-direction: column;
|
flex-direction: column;
|
||||||
}
|
}
|
||||||
|
|
||||||
@media (min-width: 768px) {
|
|
||||||
|
|
||||||
.alerts {
|
|
||||||
top: 150px;
|
|
||||||
bottom: auto;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
.alert {
|
.alert {
|
||||||
position: relative;
|
position: relative;
|
||||||
display: inline-block;
|
display: inline-block;
|
||||||
background-color: var(--color-dark);
|
background-color: var(--color-dark);
|
||||||
font-size: 1rem;
|
font-size: 1rem;
|
||||||
color: #f3f3f3;
|
color: var(--color-lightwhite);
|
||||||
z-index: 0;
|
z-index: 0;
|
||||||
max-height: 200px;
|
max-height: 200px;
|
||||||
transition: all .3s ease-in-out;
|
transition: all .3s ease-in-out;
|
||||||
@ -116,8 +108,6 @@
|
|||||||
top: 0;
|
top: 0;
|
||||||
width: 60px;
|
width: 60px;
|
||||||
height: 100%;
|
height: 100%;
|
||||||
/* TODO: remove next line as soon as messagerenderer-error in julius gets resolved */
|
|
||||||
color: var(--color-dark);
|
|
||||||
transition: all .3s ease;
|
transition: all .3s ease;
|
||||||
z-index: 40;
|
z-index: 40;
|
||||||
|
|
||||||
@ -138,7 +128,6 @@
|
|||||||
top: 50%;
|
top: 50%;
|
||||||
left: 50%;
|
left: 50%;
|
||||||
display: flex;
|
display: flex;
|
||||||
color: rgba(255, 255, 255, 0.5);
|
|
||||||
align-items: center;
|
align-items: center;
|
||||||
justify-content: center;
|
justify-content: center;
|
||||||
transform: translate(-50%, -50%);
|
transform: translate(-50%, -50%);
|
||||||
@ -158,31 +147,11 @@
|
|||||||
|
|
||||||
.alert-warning {
|
.alert-warning {
|
||||||
background-color: var(--color-warning);
|
background-color: var(--color-warning);
|
||||||
color: var(--color-dark);
|
|
||||||
|
|
||||||
.alert__close {
|
|
||||||
color: var(--color-warning);
|
|
||||||
|
|
||||||
/* TODO: remove me as soon as messagerenderer-error in julius gets resolved */
|
|
||||||
&::before {
|
|
||||||
color: var(--color-dark);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
.alert-danger,
|
.alert-danger,
|
||||||
.alert-error {
|
.alert-error {
|
||||||
background-color: var(--color-error);
|
background-color: var(--color-error);
|
||||||
color: var(--color-lightwhite);
|
|
||||||
|
|
||||||
.alert__close {
|
|
||||||
color: var(--color-error);
|
|
||||||
|
|
||||||
/* TODO: remove me as soon as messagerenderer-error in julius gets resolved */
|
|
||||||
&::before {
|
|
||||||
color: var(--color-lightwhite);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
.alert--invisible {
|
.alert--invisible {
|
||||||
|
|||||||
@ -3,7 +3,6 @@
|
|||||||
|
|
||||||
window.utils = window.utils || {};
|
window.utils = window.utils || {};
|
||||||
|
|
||||||
// allows for multiple file uploads with separate inputs
|
|
||||||
window.utils.tooltip = function(tt) {
|
window.utils.tooltip = function(tt) {
|
||||||
var handle = tt.querySelector('.tooltip__handle');
|
var handle = tt.querySelector('.tooltip__handle');
|
||||||
var content = tt.querySelector('.tooltip__content');
|
var content = tt.querySelector('.tooltip__content');
|
||||||
@ -55,13 +54,15 @@
|
|||||||
|
|
||||||
document.addEventListener('DOMContentLoaded', function() {
|
document.addEventListener('DOMContentLoaded', function() {
|
||||||
|
|
||||||
// initialize tooltips set via `data-tooltip`
|
// JS-TOOLTIPS NOT USED CURRENTLY.
|
||||||
Array.from(document.querySelectorAll('[data-tooltip]')).forEach(function(el) {
|
|
||||||
window.utils.tooltipFromAttribute(el)
|
// initialize tooltips set via `data-tooltip`
|
||||||
});
|
// Array.from(document.querySelectorAll('[data-tooltip]')).forEach(function(el) {
|
||||||
|
// window.utils.tooltipFromAttribute(el)
|
||||||
|
// });
|
||||||
|
|
||||||
// initialize tooltips
|
// initialize tooltips
|
||||||
Array.from(document.querySelectorAll('.js-tooltip')).forEach(function(tt) {
|
// Array.from(document.querySelectorAll('.js-tooltip')).forEach(function(tt) {
|
||||||
window.utils.tooltip(tt);
|
// window.utils.tooltip(tt);
|
||||||
});
|
// });
|
||||||
});
|
});
|
||||||
|
|||||||
@ -2,8 +2,8 @@
|
|||||||
position: relative;
|
position: relative;
|
||||||
display: inline-block;
|
display: inline-block;
|
||||||
|
|
||||||
.hidden {
|
&:hover .tooltip__content {
|
||||||
display: none;
|
display: inline-block;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -17,15 +17,16 @@
|
|||||||
color: white;
|
color: white;
|
||||||
display: inline-block;
|
display: inline-block;
|
||||||
text-align: center;
|
text-align: center;
|
||||||
cursor: default;
|
|
||||||
margin: 0 10px;
|
margin: 0 10px;
|
||||||
|
cursor: default;
|
||||||
}
|
}
|
||||||
|
|
||||||
.tooltip__content {
|
.tooltip__content {
|
||||||
position: absolute;
|
position: absolute;
|
||||||
|
display: none;
|
||||||
top: -10px;
|
top: -10px;
|
||||||
transform: translateY(-100%);
|
transform: translateY(-100%);
|
||||||
left: 3px;
|
right: 3px;
|
||||||
width: 275px;
|
width: 275px;
|
||||||
z-index: 10;
|
z-index: 10;
|
||||||
background-color: #fafafa;
|
background-color: #fafafa;
|
||||||
@ -33,16 +34,6 @@
|
|||||||
padding: 13px 17px;
|
padding: 13px 17px;
|
||||||
box-shadow: 0 0 20px 4px rgba(0, 0, 0, 0.1);
|
box-shadow: 0 0 20px 4px rgba(0, 0, 0, 0.1);
|
||||||
|
|
||||||
&.to-left {
|
|
||||||
left: auto;
|
|
||||||
right: 3px;
|
|
||||||
|
|
||||||
&::after {
|
|
||||||
left: auto;
|
|
||||||
right: 10px;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
&::after {
|
&::after {
|
||||||
content: '';
|
content: '';
|
||||||
width: 16px;
|
width: 16px;
|
||||||
@ -50,7 +41,7 @@
|
|||||||
background-color: #fafafa;
|
background-color: #fafafa;
|
||||||
transform: rotate(45deg);
|
transform: rotate(45deg);
|
||||||
position: absolute;
|
position: absolute;
|
||||||
left: 10px;
|
right: 10px;
|
||||||
bottom: -8px;
|
bottom: -8px;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|||||||
@ -1,17 +1,23 @@
|
|||||||
$maybe cID <- mcid
|
$maybe cID <- mcid
|
||||||
<section>
|
<section>
|
||||||
<h2>
|
<h2>
|
||||||
<a href=@{CSubmissionR tid ssh csh shn cID (SubArchiveR (ZIPArchiveName SubmissionCorrected))}>Archiv
|
<a href=@{urlArchive cID}>Archiv
|
||||||
(<a href=@{CSubmissionR tid ssh csh shn cID (SubArchiveR (ZIPArchiveName SubmissionOriginal))}>Original</a>)
|
(<a href=@{urlOriginal cID}>Original</a>)
|
||||||
$if not (null lastEdits)
|
|
||||||
<h3>_{MsgLastEdits}
|
|
||||||
<ul>
|
|
||||||
$forall (name,time) <- lastEdits
|
|
||||||
<li>_{MsgEditedBy name time}
|
|
||||||
$maybe fileTable <- mFileTable
|
$maybe fileTable <- mFileTable
|
||||||
<h3>_{MsgSubmissionFiles}
|
<h3>_{MsgSubmissionFiles}
|
||||||
^{fileTable}
|
^{fileTable}
|
||||||
|
|
||||||
|
$if not (null lastEdits)
|
||||||
|
<h3>_{MsgLastEdits}
|
||||||
|
<ul>
|
||||||
|
$forall (mbName,time) <- lastEdits
|
||||||
|
$maybe name <- mbName
|
||||||
|
<li>_{MsgEditedBy name time}
|
||||||
|
$nothing
|
||||||
|
<li>#{display time}
|
||||||
|
|
||||||
|
|
||||||
$if maySubmit
|
$if maySubmit
|
||||||
<section>
|
<section>
|
||||||
<form .form-horizontal method=post action=@{actionUrl} enctype=#{formEnctype}>
|
<form .form-horizontal method=post action=@{actionUrl} enctype=#{formEnctype}>
|
||||||
|
|||||||
@ -181,6 +181,7 @@
|
|||||||
width: 0;
|
width: 0;
|
||||||
overflow: hidden;
|
overflow: hidden;
|
||||||
z-index: -1;
|
z-index: -1;
|
||||||
|
box-shadow: 0 0 13px rgba(0, 0, 0, 0.4);
|
||||||
}
|
}
|
||||||
|
|
||||||
@media (max-width: 425px) {
|
@media (max-width: 425px) {
|
||||||
|
|||||||
@ -7,9 +7,6 @@ $if hasPageActions
|
|||||||
$of PageActionPrime (MenuItem label _mIcon route _callback)
|
$of PageActionPrime (MenuItem label _mIcon route _callback)
|
||||||
<li .pagenav__list-item>
|
<li .pagenav__list-item>
|
||||||
<a .pagenav__link-wrapper href=@{route}>#{label}
|
<a .pagenav__link-wrapper href=@{route}>#{label}
|
||||||
$of _
|
|
||||||
$forall menuType <- menuTypes
|
|
||||||
$case menuType
|
|
||||||
$of PageActionSecondary (MenuItem label _mIcon route _callback)
|
$of PageActionSecondary (MenuItem label _mIcon route _callback)
|
||||||
<li .pagenav__list-item>
|
<li .pagenav__list-item>
|
||||||
<a .pagenav__link-wrapper href=@{route}>#{label}
|
<a .pagenav__link-wrapper href=@{route}>#{label}
|
||||||
|
|||||||
Reference in New Issue
Block a user