Merge branch 'master' into 205-klausuren
This commit is contained in:
Gregor Kleen
commit
6dc1d76f0a
10
.vscode/tasks.json
vendored
10
.vscode/tasks.json
vendored
@ -58,6 +58,16 @@
|
||||
"type": "npm",
|
||||
"script": "start",
|
||||
"problemMatcher": []
|
||||
},
|
||||
{
|
||||
"type": "npm",
|
||||
"script": "frontend:lint",
|
||||
"problemMatcher": []
|
||||
},
|
||||
{
|
||||
"type": "npm",
|
||||
"script": "lint",
|
||||
"problemMatcher": []
|
||||
}
|
||||
]
|
||||
}
|
||||
26
ChangeLog.md
26
ChangeLog.md
@ -1,31 +1,37 @@
|
||||
* Version 07.06.2019
|
||||
|
||||
Abgaben können bestimmte Dateinamen und Endungen erzwingen
|
||||
|
||||
Übungsblätter bieten nun Zip-Archive für alle veröffentlichte Dateien, bzw. Dateigruppen an
|
||||
|
||||
* Version 20.05.2019
|
||||
|
||||
|
||||
Komplett überarbeitete Funktionalität zur automatischen Verteilung von Korrekturen
|
||||
|
||||
* Version 13.05.2019
|
||||
|
||||
|
||||
Kursverwalter können Teilnehmer hinzufügen
|
||||
|
||||
* Version 10.05.2019
|
||||
|
||||
|
||||
Besseres Interface zum Einstellen von Abgebenden
|
||||
|
||||
|
||||
Download von allen Dateien pro Kursmaterial/Übungsblatt
|
||||
|
||||
|
||||
* Version 04.05.2019
|
||||
|
||||
|
||||
Kursmaterial
|
||||
|
||||
* Version 29.04.2019
|
||||
|
||||
|
||||
Tutorien
|
||||
|
||||
|
||||
Anzeige von Korrektoren auf den Kursseiten
|
||||
|
||||
* Version 20.04.2019
|
||||
|
||||
|
||||
Versand von Benachrichtigungen an Kursteilnehmer
|
||||
|
||||
|
||||
Eintragen von Korrektoren und Kursverwaltern auch ohne bestehenden Account
|
||||
|
||||
* Version 27.03.2019
|
||||
|
||||
130
README.md
Normal file
130
README.md
Normal file
@ -0,0 +1,130 @@
|
||||
# "Quick Start" Guide
|
||||
|
||||
The following description applies to Ubuntu and similar debian based Linux distributions.
|
||||
|
||||
## Prerequisites
|
||||
These are the things you need to do/install before you can get started working on Uni2work.
|
||||
|
||||
### Clone repository
|
||||
Clone this repository and navigate into it
|
||||
```sh
|
||||
$ git clone https://gitlab.cip.ifi.lmu.de/jost/UniWorX.git && cd UniWorX
|
||||
```
|
||||
|
||||
### `LDAP`
|
||||
LDAP is needed to handle logins.
|
||||
|
||||
Install:
|
||||
```sh
|
||||
sudo apt-get install slapd ldap-utils
|
||||
```
|
||||
|
||||
### `PostgreSQL`
|
||||
PostgreSQL will serve as database for Uni2work.
|
||||
|
||||
Install:
|
||||
```sh
|
||||
$ sudo apt-get install postgresql
|
||||
```
|
||||
|
||||
Switch to user *postgres* (got created during installation):
|
||||
```sh
|
||||
$ sudo -i -u postgres
|
||||
```
|
||||
|
||||
Add new database user *uniworx*:
|
||||
```sh
|
||||
$ createuser --interactive
|
||||
```
|
||||
|
||||
You'll get a prompt:
|
||||
|
||||
```sh
|
||||
Enter name of role to add: uniworx
|
||||
Shall the new role be a superuser? (y/n) [not exactly sure. Guess not?]
|
||||
Password: uniworx
|
||||
...
|
||||
```
|
||||
|
||||
Create database *uniworx*:
|
||||
```sh
|
||||
$ psql -c 'create database uniworx owner uniworx'
|
||||
$ psql -c 'create database uniworx_test owner uniworx'
|
||||
```
|
||||
|
||||
After you added the database switch back to your own user with `Ctrl + D`.
|
||||
|
||||
To properly access the database you now need to add a new linux user called *uniworx*. Enter "uniworx" as the password.
|
||||
```sh
|
||||
$ sudo adduser uniworx
|
||||
```
|
||||
|
||||
### `Stack`
|
||||
Stack is a toolbox for "Haskellers" to aid in developing Haskell projects.
|
||||
|
||||
Install:
|
||||
```sh
|
||||
$ curl -sSL https://get.haskellstack.org/ | sh
|
||||
```
|
||||
|
||||
Setup stack and install dependencies. This needs to be run from inside the directory you cloned this repository to:
|
||||
```sh
|
||||
$ stack setup
|
||||
```
|
||||
|
||||
During this step or the next you might get an error that says something about missing C libraries for `ldap` and `lber`. You can install these using
|
||||
```sh
|
||||
$ sudo apt-get install libsasl2-dev libldap2-dev
|
||||
```
|
||||
|
||||
If you get an error that says *You need to install postgresql-server-dev-X.Y for building a server-side extension or libpq-dev for building a client-side application.*
|
||||
Go ahead and install `libpq-dev` with
|
||||
```sh
|
||||
$ sudo apt-get install libpq-dev
|
||||
```
|
||||
|
||||
Other packages you might need to install during this process:
|
||||
```sh
|
||||
$ sudo apt-get install pkg-config
|
||||
$ sudo apt-get install libsodium-dev
|
||||
```
|
||||
|
||||
Build the app:
|
||||
```sh
|
||||
$ stack build
|
||||
```
|
||||
|
||||
This might take a few minutes... if not hours... be prepared.
|
||||
|
||||
install yesod:
|
||||
```sh
|
||||
$ stack install yesod-bin --install-ghc
|
||||
```
|
||||
|
||||
### `Node` & `npm`
|
||||
Node and Npm are needed to compile the frontend.
|
||||
|
||||
Install:
|
||||
```sh
|
||||
$ curl -sL https://deb.nodesource.com/setup_12.x | sudo -E bash -
|
||||
$ sudo apt-get install -y nodejs
|
||||
```
|
||||
|
||||
### Add dummy data to the database
|
||||
After building the app you can prepare the database and add some dummy data:
|
||||
```sh
|
||||
$ ./db.sh -f
|
||||
```
|
||||
|
||||
## Run Uni2work
|
||||
```sh
|
||||
$ npm start
|
||||
```
|
||||
|
||||
This will compile both frontend and backend and will start Uni2work in development mode (might take a few minutes the first time). It will keep running and will watch any file changes to automatically re-compile the application if necessary.
|
||||
|
||||
If you followed the steps above you should now be able to visit http://localhost:3000 and login as one of the accounts from the Development-Logins dropdown.
|
||||
|
||||
## Troubleshooting
|
||||
|
||||
Please see the [wiki](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/wikis/home) for more infos.
|
||||
@ -296,20 +296,18 @@ export class AsyncTable {
|
||||
return el.getAttribute('href') || el.querySelector('a').getAttribute('href');
|
||||
}
|
||||
|
||||
_changePagesizeHandler = (event) => {
|
||||
const paginationParamKey = this._asyncTableId + '-pagination';
|
||||
const pagesizeParamKey = this._asyncTableId + '-pagesize';
|
||||
const pageParamKey = this._asyncTableId + '-page';
|
||||
|
||||
const paginationParamEl = this._pagesizeForm.querySelector('[name="' + paginationParamKey + '"]');
|
||||
_changePagesizeHandler = () => {
|
||||
const url = new URL(getLocalStorageParameter('currentTableUrl') || window.location.href);
|
||||
url.searchParams.set(pagesizeParamKey, event.target.value);
|
||||
url.searchParams.set(pageParamKey, 0);
|
||||
const formData = new FormData(this._pagesizeForm);
|
||||
|
||||
if (paginationParamEl) {
|
||||
const encodedValue = encodeURIComponent(paginationParamEl.value);
|
||||
url.searchParams.set(paginationParamKey, encodedValue);
|
||||
for (var k of url.searchParams.keys()) {
|
||||
url.searchParams.delete(k);
|
||||
}
|
||||
|
||||
for (var kv of formData.entries()) {
|
||||
url.searchParams.append(kv[0], kv[1]);
|
||||
}
|
||||
|
||||
this._updateTableFrom(url.href);
|
||||
}
|
||||
|
||||
|
||||
@ -36,7 +36,7 @@ export class CheckAll {
|
||||
}
|
||||
|
||||
destroy() {
|
||||
console.log('TBD: Destroy CheckAll');
|
||||
this._checkAllCheckbox.destroy();
|
||||
}
|
||||
|
||||
_getCheckboxId() {
|
||||
@ -95,7 +95,7 @@ export class CheckAll {
|
||||
// set up new checkbox
|
||||
this._app.utilRegistry.setupAll(th);
|
||||
|
||||
this._checkAllCheckbox.addEventListener('input', this._onCheckAllCheckboxInput);
|
||||
this._checkAllCheckbox.addEventListener('input', () => this._onCheckAllCheckboxInput());
|
||||
this._setupCheckboxListeners();
|
||||
}
|
||||
|
||||
@ -108,7 +108,7 @@ export class CheckAll {
|
||||
return cell.querySelector(CHECKBOX_SELECTOR);
|
||||
})
|
||||
.forEach((checkbox) => {
|
||||
checkbox.addEventListener('input', this.updateCheckAllCheckboxState);
|
||||
checkbox.addEventListener('input', () => this._updateCheckAllCheckboxState());
|
||||
});
|
||||
}
|
||||
|
||||
|
||||
@ -395,19 +395,28 @@ UpdatedAssignedCorrectorsAuto num@Int64: #{display num} Abgaben wurden unter den
|
||||
CouldNotAssignCorrectorsAuto num@Int64: #{display num} Abgaben konnten nicht automatisch zugewiesen werden:
|
||||
SelfCorrectors num@Int64: #{display num} Abgaben wurden Abgebenden als eigenem Korrektor zugeteilt!
|
||||
|
||||
|
||||
CorrectionSheets: Übersicht Korrekturen nach Blättern
|
||||
CorrectionCorrectors: Übersicht Korrekturen nach Korrektoren
|
||||
AssignSubmissionExceptionNoCorrectors: Es sind keine Korrektoren eingestellt
|
||||
AssignSubmissionExceptionNoCorrectorsByProportion: Es sind keine Korrektoren mit Anteil ungleich Null eingestellt
|
||||
AssignSubmissionExceptionSubmissionsNotFound n@Int: #{tshow n} Abgaben konnten nicht gefunden werden
|
||||
NrSubmittorsTotal: Abgebende
|
||||
NrSubmissionsTotal: Abgaben
|
||||
NrSubmissionsUnassigned: Ohne Korrektor
|
||||
NoCorrectorAssigned: Ohne Korrektor
|
||||
NrCorrectors: Korrektoren
|
||||
NrSubmissionsNewlyAssigned: Neu zugeteilt
|
||||
NrSubmissionsNotAssigned: Nicht zugeteilt
|
||||
NrSubmissionsNotCorrected: Unkorrigiert
|
||||
CorrectionTime: Korrekturdauer (Min/Avg/Max)
|
||||
AssignSubmissionsRandomWarning: Die Zuteilungsvorschau kann von der tatsächlichen Zuteilung abweichen, wenn mehrere Blätter auf einmal zugeteilt werden, da beim Ausgleich der Kontigente nur bereits zugeteilte Abgaben berücksichtigt werden. Da es ein randomisierte Prozess ist, kann es auch bei einzelnen Blättern gerinfgügige Abweichungen geben.
|
||||
|
||||
CorrectionsUploaded num@Int64: #{display num} Korrekturen wurden gespeichert:
|
||||
NoCorrectionsUploaded: In der hochgeladenen Datei wurden keine Korrekturen gefunden.
|
||||
|
||||
RatingBy: Korrigiert von
|
||||
HasCorrector: Korrektor zugeteilt
|
||||
AssignedTime: Zuteilung
|
||||
AchievedBonusPoints: Erreichte Bonuspunkte
|
||||
AchievedNormalPoints: Erreichte Punkte
|
||||
@ -832,7 +841,8 @@ MenuCorrectionsUpload: Korrekturen hochladen
|
||||
MenuCorrectionsDownload: Offene Abgaben herunterladen
|
||||
MenuCorrectionsCreate: Abgaben registrieren
|
||||
MenuCorrectionsGrade: Abgaben online korrigieren
|
||||
MenuCorrectionsAssign: Abgaben automatisch zuteilen
|
||||
MenuCorrectionsAssign: Zuteilung Korrekturen
|
||||
MenuCorrectionsAssignSheet name@Text: Zuteilung Korrekturen von #{name}
|
||||
MenuAuthPreds: Authorisierungseinstellungen
|
||||
MenuTutorialDelete: Tutorium löschen
|
||||
MenuTutorialEdit: Tutorium editieren
|
||||
@ -983,7 +993,7 @@ TutorialDelete: Löschen
|
||||
CourseExams: Klausuren
|
||||
CourseTutorials: Übungen
|
||||
|
||||
ParticipantsN n@Int: Teilnehmer
|
||||
ParticipantsN n@Int: #{tshow n} Teilnehmer
|
||||
TutorialDeleteQuestion: Wollen Sie das unten aufgeführte Tutorium wirklich löschen?
|
||||
TutorialDeleted: Tutorium gelöscht
|
||||
|
||||
@ -1020,6 +1030,7 @@ HealthLDAPAdmins: Anteil der Administratoren, die im LDAP-Verzeichnis gefunden w
|
||||
HealthSMTPConnect: SMTP-Server kann erreicht werden
|
||||
HealthWidgetMemcached: Memcached-Server liefert Widgets korrekt aus
|
||||
|
||||
CourseParticipants n@Int: Derzeit #{tshow n} angemeldete Kursteilnehmer
|
||||
CourseParticipantsInvited n@Int: #{tshow n} #{pluralDE n "Einladung" "Einladungen"} per E-Mail verschickt
|
||||
CourseParticipantsAlreadyRegistered n@Int: #{tshow n} Teilnehmer #{pluralDE n "ist" "sind"} bereits angemeldet
|
||||
CourseParticipantsRegisteredWithoutField n@Int: #{tshow n} Teilnehmer #{pluralDE n "wurde ohne assoziiertes Hauptfach" "wurden assoziierte Hauptfächer"} angemeldet, da #{pluralDE n "kein eindeutiges Hauptfach bestimmt werden konnte" "keine eindeutigen Hauptfächer bestimmt werden konnten"}
|
||||
|
||||
@ -4,7 +4,7 @@ Sheet -- exercise sheet for a given course
|
||||
description Html Maybe
|
||||
type SheetType -- Does it count towards overall course grade?
|
||||
grouping SheetGroup -- May participants submit in groups of certain sizes?
|
||||
markingText Html Maybe -- Instructions for correctors, included in marking templates
|
||||
markingText Html Maybe -- Instructons for correctors, included in marking templates
|
||||
visibleFrom UTCTime Maybe -- Invisible to enrolled participants before
|
||||
activeFrom UTCTime -- Download of questions and submission is permitted afterwards
|
||||
activeTo UTCTime -- Submission is only permitted before
|
||||
|
||||
@ -1443,7 +1443,7 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb (CourseR tid ssh csh CInviteR) = return ("Einladung", Just $ CourseR tid ssh csh CShowR)
|
||||
breadcrumb (CourseR tid ssh csh (CUserR _)) = return ("Teilnehmer" , Just $ CourseR tid ssh csh CUsersR)
|
||||
breadcrumb (CourseR tid ssh csh CCorrectionsR) = return ("Abgaben" , Just $ CourseR tid ssh csh CShowR)
|
||||
breadcrumb (CourseR tid ssh csh CAssignR) = return ("Zuteilen" , Just $ CourseR tid ssh csh CCorrectionsR)
|
||||
breadcrumb (CourseR tid ssh csh CAssignR) = return ("Zuteilung" , Just $ CourseR tid ssh csh CCorrectionsR)
|
||||
breadcrumb (CourseR tid ssh csh SheetListR) = return ("Übungen" , Just $ CourseR tid ssh csh CShowR)
|
||||
breadcrumb (CourseR tid ssh csh SheetNewR ) = return ("Neu", Just $ CourseR tid ssh csh SheetListR)
|
||||
breadcrumb (CourseR tid ssh csh SheetCurrentR) = return ("Aktuelles Blatt", Just $ CourseR tid ssh csh SheetListR)
|
||||
@ -1766,7 +1766,7 @@ pageActions InstanceR = [
|
||||
]
|
||||
pageActions (HelpR) = [
|
||||
-- MenuItem
|
||||
-- { menuItemType = PageActionPrime
|
||||
-- { menuItemType = PageActionPrime
|
||||
-- , menuItemLabel = MsgInfoLecturerTitle
|
||||
-- , menuItemIcon = Nothing
|
||||
-- , menuItemRoute = SomeRoute InfoLecturerR
|
||||
@ -1776,7 +1776,7 @@ pageActions (HelpR) = [
|
||||
]
|
||||
pageActions (ProfileR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuProfileData
|
||||
, menuItemIcon = Just "book"
|
||||
, menuItemRoute = SomeRoute ProfileDataR
|
||||
@ -1784,7 +1784,7 @@ pageActions (ProfileR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuAuthPreds
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute AuthPredsR
|
||||
@ -1794,7 +1794,7 @@ pageActions (ProfileR) =
|
||||
]
|
||||
pageActions TermShowR =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuTermCreate
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute TermEditR
|
||||
@ -1804,7 +1804,7 @@ pageActions TermShowR =
|
||||
]
|
||||
pageActions (TermCourseListR tid) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCourseNew
|
||||
, menuItemIcon = Just "book"
|
||||
, menuItemRoute = SomeRoute CourseNewR
|
||||
@ -1812,7 +1812,7 @@ pageActions (TermCourseListR tid) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuTermEdit
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ TermEditExistR tid
|
||||
@ -1832,7 +1832,7 @@ pageActions (TermSchoolCourseListR _tid _ssh) =
|
||||
]
|
||||
pageActions (CourseListR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCourseNew
|
||||
, menuItemIcon = Just "book"
|
||||
, menuItemRoute = SomeRoute CourseNewR
|
||||
@ -1842,7 +1842,7 @@ pageActions (CourseListR) =
|
||||
]
|
||||
pageActions (CourseNewR) = [
|
||||
MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgInfoLecturerTitle
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute InfoLecturerR
|
||||
@ -1871,7 +1871,7 @@ pageActions (CourseR tid ssh csh CShowR) =
|
||||
in runDB $ lecturerAccess `or2M` existsVisible
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSheetList
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetListR
|
||||
@ -1926,7 +1926,7 @@ pageActions (CourseR tid ssh csh CShowR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuCourseCommunication
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CCommR
|
||||
@ -1934,7 +1934,7 @@ pageActions (CourseR tid ssh csh CShowR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuCourseEdit
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CEditR
|
||||
@ -1942,7 +1942,7 @@ pageActions (CourseR tid ssh csh CShowR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuCourseClone
|
||||
, menuItemIcon = Just "copy"
|
||||
, menuItemRoute = SomeRoute (CourseNewR, [("tid", toPathPiece tid), ("ssh", toPathPiece ssh), ("csh", toPathPiece csh)])
|
||||
@ -1950,9 +1950,9 @@ pageActions (CourseR tid ssh csh CShowR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuCourseDelete
|
||||
, menuItemIcon = Just "trash"
|
||||
, menuItemIcon = Just "trash"
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CDeleteR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
@ -1960,17 +1960,17 @@ pageActions (CourseR tid ssh csh CShowR) =
|
||||
]
|
||||
pageActions (CourseR tid ssh csh CCorrectionsR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCorrectionsAssign
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CAssignR
|
||||
, menuItemModal = True
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (CourseR tid ssh csh SheetListR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSheetCurrent
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetCurrentR
|
||||
@ -1980,7 +1980,7 @@ pageActions (CourseR tid ssh csh SheetListR) =
|
||||
return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSheetOldUnassigned
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetOldUnassignedR
|
||||
@ -1990,25 +1990,25 @@ pageActions (CourseR tid ssh csh SheetListR) =
|
||||
return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSubmissions
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CCorrectionsR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCorrectionsAssign
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CAssignR
|
||||
, menuItemModal = True
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCorrectionsOwn
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute (CorrectionsR, [ ("corrections-term" , termToText $ unTermKey tid)
|
||||
, ("corrections-school", CI.original $ unSchoolKey ssh)
|
||||
, ("corrections-course", CI.original csh)
|
||||
@ -2029,7 +2029,7 @@ pageActions (CourseR tid ssh csh SheetListR) =
|
||||
return ok
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSheetNew
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetNewR
|
||||
@ -2143,7 +2143,7 @@ pageActions (CExamR tid ssh csh examn EShowR) =
|
||||
]
|
||||
pageActions (CSheetR tid ssh csh shn SShowR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSubmissionNew
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SubmissionNewR
|
||||
@ -2155,7 +2155,7 @@ pageActions (CSheetR tid ssh csh shn SShowR) =
|
||||
return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSubmissionOwn
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SubmissionOwnR
|
||||
@ -2179,49 +2179,49 @@ pageActions (CSheetR tid ssh csh shn SShowR) =
|
||||
, menuItemAccessCallback' = (== Authorized) <$> evalAccessCorrector tid ssh csh
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCorrectors
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SCorrR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSubmissions
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SSubsR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCorrectionsAssign
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SAssignR
|
||||
, menuItemModal = True
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSheetEdit
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SEditR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuSheetClone
|
||||
, menuItemIcon = Just "copy"
|
||||
, menuItemIcon = Just "copy"
|
||||
, menuItemRoute = SomeRoute (CourseR tid ssh csh SheetNewR, [("shn", toPathPiece shn)])
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuSheetDelete
|
||||
, menuItemIcon = Just "trash"
|
||||
, menuItemIcon = Just "trash"
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SDelR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
@ -2229,7 +2229,7 @@ pageActions (CSheetR tid ssh csh shn SShowR) =
|
||||
]
|
||||
pageActions (CSheetR tid ssh csh shn SSubsR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSubmissionNew
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SubmissionNewR
|
||||
@ -2237,25 +2237,25 @@ pageActions (CSheetR tid ssh csh shn SSubsR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCorrectors
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SCorrR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCorrectionsAssign
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SAssignR
|
||||
, menuItemModal = True
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (CSubmissionR tid ssh csh shn cid SubShowR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCorrection
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR
|
||||
@ -2263,7 +2263,7 @@ pageActions (CSubmissionR tid ssh csh shn cid SubShowR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgCorrectorAssignTitle
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSubmissionR tid ssh csh shn cid SubAssignR
|
||||
@ -2271,7 +2271,7 @@ pageActions (CSubmissionR tid ssh csh shn cid SubShowR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuSubmissionDelete
|
||||
, menuItemIcon = Just "trash"
|
||||
, menuItemRoute = SomeRoute $ CSubmissionR tid ssh csh shn cid SubDelR
|
||||
@ -2281,7 +2281,7 @@ pageActions (CSubmissionR tid ssh csh shn cid SubShowR) =
|
||||
]
|
||||
pageActions (CSubmissionR tid ssh csh shn cid CorrectionR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuSubmissionDelete
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSubmissionR tid ssh csh shn cid SubDelR
|
||||
@ -2291,17 +2291,17 @@ pageActions (CSubmissionR tid ssh csh shn cid CorrectionR) =
|
||||
]
|
||||
pageActions (CSheetR tid ssh csh shn SCorrR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSubmissions
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SSubsR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuSheetEdit
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SEditR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
|
||||
@ -5,6 +5,7 @@ import Import
|
||||
|
||||
import Jobs
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Corrections
|
||||
import Handler.Utils.Submission
|
||||
import Handler.Utils.Table.Cells
|
||||
import Handler.Utils.SheetType
|
||||
@ -13,11 +14,11 @@ import Handler.Utils.Delete
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import Data.List (nub)
|
||||
import Data.List as List (nub, foldl, foldr)
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import Data.Map (Map, (!))
|
||||
import qualified Data.Map as Map
|
||||
import Data.Map.Strict (Map, (!))
|
||||
import qualified Data.Map.Strict as Map
|
||||
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
@ -250,7 +251,7 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
|
||||
E.orderBy [E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName]
|
||||
return (user, pseudonym E.?. SheetPseudonymPseudonym)
|
||||
let
|
||||
submittorMap = foldr (\(Entity userId user, E.Value pseudo) -> Map.insert userId (user, pseudo)) Map.empty submittors
|
||||
submittorMap = List.foldr (\(Entity userId user, E.Value pseudo) -> Map.insert userId (user, pseudo)) Map.empty submittors
|
||||
dbtProj' (submission, sheet, (courseName, courseShorthand, courseTerm, courseSchool), mCorrector, mbLastEdit, submittorMap)
|
||||
dbTable psValidator DBTable
|
||||
{ dbtSQLQuery
|
||||
@ -333,6 +334,12 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
|
||||
| otherwise -> corrector E.?. UserEmail `E.in_` E.justList (E.valList . catMaybes $ Set.toList emails)
|
||||
E.||. (if Nothing `Set.member` emails then E.isNothing (corrector E.?. UserEmail) else E.val False)
|
||||
)
|
||||
, ( "isassigned"
|
||||
, FilterColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) criterion -> case getLast (criterion :: Last Bool) of
|
||||
Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
Just True -> E.not_ . E.isNothing $ submission E.^. SubmissionRatingBy
|
||||
Just False-> E.isNothing $ submission E.^. SubmissionRatingBy
|
||||
)
|
||||
, ( "israted"
|
||||
, FilterColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) criterion -> case getLast (criterion :: Last Bool) of
|
||||
Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
@ -635,10 +642,11 @@ postCCorrectionsR tid ssh csh = do
|
||||
filterUI = Just $ \mPrev -> mconcat
|
||||
[ prismAForm (singletonFilter "user-name-email") mPrev $ aopt textField (fslI MsgCourseMembers)
|
||||
, prismAForm (singletonFilter "user-matriclenumber") mPrev $ aopt textField (fslI MsgMatrikelNr)
|
||||
, prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
|
||||
-- "pseudonym" TODO DB only stores Word24
|
||||
-- "pseudonym" TODO DB only stores Word24
|
||||
, Map.singleton "sheet-search" . maybeToList <$> aopt textField (fslI MsgSheet) (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev)))
|
||||
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgRatingTime)
|
||||
, prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
|
||||
, prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgHasCorrector)
|
||||
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgRatingTime)
|
||||
]
|
||||
psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
|
||||
correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
|
||||
@ -668,8 +676,9 @@ postSSubsR tid ssh csh shn = do
|
||||
[ prismAForm (singletonFilter "user-name-email") mPrev $ aopt textField (fslI MsgCourseMembers)
|
||||
, prismAForm (singletonFilter "user-matriclenumber") mPrev $ aopt textField (fslI MsgMatrikelNr)
|
||||
, prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
|
||||
-- "pseudonym" TODO DB only stores Word24
|
||||
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgRatingTime)
|
||||
, prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgHasCorrector)
|
||||
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgRatingTime)
|
||||
-- "pseudonym" TODO DB only stores Word24
|
||||
]
|
||||
psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
|
||||
correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
|
||||
@ -1035,25 +1044,27 @@ embedRenderMessage ''UniWorX ''ButtonSubmissionsAssign id
|
||||
instance Button UniWorX ButtonSubmissionsAssign where
|
||||
btnClasses BtnSubmissionsAssign = [BCIsButton, BCPrimary]
|
||||
|
||||
-- | Gather info about corrector assignment per sheet
|
||||
-- | DEPRECATED use CorrectorInfo instead. Gather info about corrector assignment per sheet
|
||||
data SubAssignInfo = SubAssignInfo { saiName :: SheetName, saiSubmissionNr, saiCorrectorNr, saiUnassignedNr :: Int }
|
||||
|
||||
getCAssignR, postCAssignR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getCAssignR = postCAssignR
|
||||
postCAssignR tid ssh csh = do
|
||||
shids <- runDB $ do
|
||||
(shids,cid) <- runDB $ do
|
||||
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
selectKeysList [SheetCourse ==. cid] [Asc SheetActiveTo]
|
||||
assignHandler tid ssh csh shids
|
||||
shids <- selectKeysList [SheetCourse ==. cid] [Asc SheetActiveTo]
|
||||
return (shids,cid)
|
||||
assignHandler tid ssh csh cid shids
|
||||
|
||||
getSAssignR, postSAssignR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
|
||||
getSAssignR = postSAssignR
|
||||
postSAssignR tid ssh csh shn = do
|
||||
shid <- runDB $ fetchSheetId tid ssh csh shn
|
||||
assignHandler tid ssh csh [shid]
|
||||
(shid,cid) <- runDB $ fetchSheetIdCourseId tid ssh csh shn
|
||||
assignHandler tid ssh csh cid [shid]
|
||||
|
||||
assignHandler :: TermId -> SchoolId -> CourseShorthand -> [SheetId] -> Handler Html
|
||||
assignHandler tid ssh csh rawSids = do
|
||||
-- DEPRECATED assignHandler', delete me soonish
|
||||
assignHandler' :: TermId -> SchoolId -> CourseShorthand -> CourseId -> [SheetId] -> Handler Html
|
||||
assignHandler' tid ssh csh _cid rawSids = do
|
||||
-- gather data
|
||||
openSubs <- runDB $ (\f -> foldM f Map.empty rawSids) $
|
||||
\acc sid -> maybeT (return acc) $ do
|
||||
@ -1079,7 +1090,7 @@ assignHandler tid ssh csh rawSids = do
|
||||
\acc sid -> flip (Map.insert sid) acc <$> assignSubmissions sid Nothing
|
||||
-- Too much important information for an alert message. Display proper info page instead
|
||||
let btnForm = wrapForm btnWdgt def
|
||||
{ formAction = SomeRoute <$> currentRoute -- TODO: should be a modal route
|
||||
{ formAction = SomeRoute <$> currentRoute
|
||||
, formEncoding = btnEnctype
|
||||
, formSubmit = FormNoSubmit
|
||||
}
|
||||
@ -1092,3 +1103,151 @@ assignHandler tid ssh csh rawSids = do
|
||||
then linkBack -- TODO: convenience link might be unnecessary: either via breadcrumb or closing model. Remove, if modal works fine. Otherwise change to PrimaryAction?
|
||||
else btnForm
|
||||
|
||||
|
||||
{- TODO: make buttons for each sheet, so that users see which sheet is assigned
|
||||
data ButtonCorrectionsAssign = BtnCorrectionsAssignAll | BtnCorrectionsAssignSheet SheetName
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Button UniWorX ButtonCorrectionsAssign
|
||||
-- Are those needed any more?
|
||||
instance Universe ButtonCorrectionsAssign
|
||||
instance Finite ButtonCorrectionsAssign
|
||||
nullaryPathPiece ''ButtonCorrectionsAssign camelToPathPiece
|
||||
embedRenderMessage ''UniWorX ''ButtonCorrectionsAssign id
|
||||
instance Button UniWorX ButtonCorrectionsAssign where
|
||||
btnClasses BtnCorrectionsAssign = [BCIsButton, BCPrimary]
|
||||
-- use runButtonForm' instead later on
|
||||
-}
|
||||
|
||||
assignHandler :: TermId -> SchoolId -> CourseShorthand -> CourseId -> [SheetId] -> Handler Html
|
||||
assignHandler tid ssh csh cid assignSids = do
|
||||
-- evaluate form first, since it affects DB action
|
||||
(btnWdgt, btnResult) <- runButtonForm FIDAssignSubmissions
|
||||
|
||||
-- gather data
|
||||
(nrParticipants, groupsPossible, infoMap, correctorMap, assignment) <- runDB $ do
|
||||
-- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
nrParticipants <- count [CourseParticipantCourse ==. cid]
|
||||
|
||||
sheetList <- selectList [SheetCourse ==. cid] [Asc SheetName]
|
||||
let sheets = entities2map sheetList
|
||||
sheetIds = Map.keys sheets
|
||||
groupsPossible :: Bool
|
||||
groupsPossible =
|
||||
let foldFun (Entity _ Sheet{sheetGrouping=sgr}) acc = acc || sgr /= NoGroups
|
||||
in List.foldr foldFun False sheetList
|
||||
|
||||
-- plan or assign unassigned submissions for given sheets
|
||||
let buildA :: (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int)) -> SheetId -> DB (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int))
|
||||
buildA acc sid = maybeT (return acc) $ do
|
||||
let shn = sheetName $ sheets ! sid
|
||||
-- is sheet closed?
|
||||
guardM $ lift $ hasWriteAccessTo $ CSheetR tid ssh csh shn SAssignR -- we must check, whether the submission is already closed and thus assignable
|
||||
-- has at least one uncorrected / unassigned submisison?
|
||||
[E.Value hasSubmission] <- lift $ E.select $ return $ E.exists $ E.from $ \submission -> do
|
||||
E.where_ $ submission E.^. SubmissionSheet E.==. E.val sid
|
||||
E.where_ $ E.isNothing $ submission E.^. SubmissionRatingBy -- no corrector
|
||||
E.where_ $ E.isNothing $ submission E.^. SubmissionRatingTime -- not done
|
||||
guard hasSubmission
|
||||
-- has at least one active corrector?
|
||||
[E.Value hasCorrector] <- lift $ E.select $ return $ E.exists $ E.from $ \corrector -> do
|
||||
E.where_ $ corrector E.^. SheetCorrectorSheet E.==. E.val sid
|
||||
E.where_ $ corrector E.^. SheetCorrectorState E.==. E.val CorrectorNormal
|
||||
-- E.where_ $ corrector E.^. SheetCorrectorLoad E./=. E.val (Load {byTutorial = Nothing, byProportion = 0})
|
||||
guard hasCorrector
|
||||
-- TODO: Refactor guards above! We already have these informations, but forcing the maps inside the DB acces might not be a good idea
|
||||
-- TODO: Maybe refactor planSubmissions instead to not throw exceptions, but signal "ok" or "not possible" instead!
|
||||
plan <- lift $ planSubmissions sid Nothing
|
||||
status <- lift $ case btnResult of
|
||||
Nothing -> return (Set.empty, Set.empty)
|
||||
(Just BtnSubmissionsAssign) -> writeSubmissionPlan plan -- TODO: this comes to late!!
|
||||
return $ Map.insert shn (status, countMapElems plan) acc
|
||||
assignment <- foldM buildA Map.empty assignSids
|
||||
|
||||
correctors <- E.select . E.from $ \(corrector `E.InnerJoin` user) -> do
|
||||
E.on $ corrector E.^. SheetCorrectorUser E.==. user E.^. UserId
|
||||
E.where_ $ corrector E.^. SheetCorrectorSheet `E.in_` E.valList sheetIds
|
||||
return (corrector, user)
|
||||
let correctorMap :: Map UserId (User, Map SheetName SheetCorrector)
|
||||
correctorMap = (\f -> foldl f Map.empty correctors) (\acc (Entity _ sheetcorr@SheetCorrector{sheetCorrectorSheet}, Entity uid user) ->
|
||||
let shn = sheetName $ sheets ! sheetCorrectorSheet
|
||||
in Map.insertWith (\(usr, ma) (_, mb) -> (usr, Map.union ma mb)) uid (user, Map.singleton shn sheetcorr) acc
|
||||
)
|
||||
|
||||
submissions <- E.select . E.from $ \submission -> do
|
||||
E.where_ $ submission E.^. SubmissionSheet `E.in_` E.valList sheetIds
|
||||
let numSubmittors = E.sub_select . E.from $ \subUser -> do
|
||||
E.where_ $ submission E.^. SubmissionId E.==. subUser E.^. SubmissionUserSubmission
|
||||
return E.countRows
|
||||
return (submission, numSubmittors)
|
||||
-- prepare map
|
||||
let infoMap :: Map SheetName (Map (Maybe UserId) CorrectionInfo)
|
||||
infoMap = List.foldl (flip buildS) emptySheets submissions
|
||||
|
||||
-- ensure that all sheets are shown, including those without any submissions
|
||||
emptySheets = foldl (\m sid -> Map.insert (sheetName $ sheets ! sid) emptyCorrs m) Map.empty sheetIds
|
||||
emptyCorrs = foldl (\m uid -> let cic = Just uid in
|
||||
Map.insert cic mempty{ciCorrector=cic} m) Map.empty $ Map.keys correctorMap
|
||||
|
||||
|
||||
buildS :: (Entity Submission, E.Value Int64) -> Map SheetName (Map (Maybe UserId) CorrectionInfo) -> Map SheetName (Map (Maybe UserId) CorrectionInfo)
|
||||
buildS (Entity _sheetId Submission{..}, E.Value nrSbmtrs) m =
|
||||
let shnm = sheetName $ sheets ! submissionSheet
|
||||
corTime = diffUTCTime <$> submissionRatingTime <*> submissionRatingAssigned
|
||||
cinf = Map.singleton submissionRatingBy $ CorrectionInfo
|
||||
{ ciSubmittors = fromIntegral nrSbmtrs
|
||||
, ciSubmissions = 1
|
||||
, ciAssigned = maybe 0 (const 1) submissionRatingBy -- only used in sheetMap
|
||||
, ciCorrected = maybe 0 (const 1) submissionRatingTime
|
||||
, ciCorrector = submissionRatingBy
|
||||
, ciMin = corTime
|
||||
, ciTot = corTime
|
||||
, ciMax = corTime
|
||||
}
|
||||
in Map.insertWith (Map.unionWith (<>)) shnm cinf m
|
||||
|
||||
return (nrParticipants, groupsPossible, infoMap, correctorMap, assignment)
|
||||
|
||||
let -- infoMap :: Map SheetName (Map (Maybe UserId) CorrectionInfo) -- repeated here for easier reference
|
||||
-- create aggregate maps
|
||||
sheetMap :: Map SheetName CorrectionInfo
|
||||
sheetMap = Map.map fold infoMap
|
||||
corrMap :: Map (Maybe UserId) CorrectionInfo
|
||||
corrMap = Map.unionsWith (<>) $ Map.elems infoMap
|
||||
sheetNames = Map.keys infoMap
|
||||
let -- whamlet convenience functions
|
||||
-- avoid nestes hamelt $maybe with duplicated $nothing
|
||||
getCorrector :: Maybe UserId -> (Widget,Map SheetName SheetCorrector)
|
||||
getCorrector (Just uid)
|
||||
| Just (User{..},loadMap) <- Map.lookup uid correctorMap
|
||||
= (nameEmailWidget userEmail userDisplayName userSurname, loadMap)
|
||||
getCorrector _ = ([whamlet|_{MsgNoCorrectorAssigned}|], mempty)
|
||||
-- avoid nestes hamelt $maybe with duplicated $nothing
|
||||
getCorrSheetStatus :: Maybe UserId -> SheetName -> Maybe CorrectionInfo
|
||||
getCorrSheetStatus corr shn
|
||||
| (Just smap) <- Map.lookup shn infoMap
|
||||
= Map.lookup corr smap
|
||||
getCorrSheetStatus _ _ = Nothing
|
||||
-- avoid nestes hamelt $maybe with duplicated $nothing
|
||||
getCorrNewAssignment :: Maybe UserId -> SheetName -> Maybe Int
|
||||
getCorrNewAssignment corr shn
|
||||
| (Just (_,cass)) <- Map.lookup shn assignment
|
||||
= Map.lookup corr cass
|
||||
getCorrNewAssignment _ _ = Nothing
|
||||
|
||||
showDiffDays :: Maybe NominalDiffTime -> Text
|
||||
showDiffDays = foldMap formatDiffDays
|
||||
showAvgsDays :: Maybe NominalDiffTime -> Integer -> Text
|
||||
showAvgsDays Nothing _ = mempty
|
||||
showAvgsDays (Just dt) n = formatDiffDays $ dt / fromIntegral n
|
||||
heat :: Integer -> Integer -> Double
|
||||
heat full achieved = roundToDigits 3 $ cutOffPercent 0.4 (fromIntegral full) (fromIntegral achieved)
|
||||
let headingShort
|
||||
| 0 < Map.size assignment = MsgMenuCorrectionsAssignSheet $ Text.intercalate ", " $ fmap CI.original $ Map.keys assignment
|
||||
| otherwise = MsgMenuCorrectionsAssign
|
||||
headingLong = prependCourseTitle tid ssh csh MsgMenuCorrectionsAssign
|
||||
siteLayoutMsg headingShort $ do
|
||||
setTitleI headingLong
|
||||
$(widgetFile "corrections-overview")
|
||||
|
||||
|
||||
|
||||
|
||||
@ -136,7 +136,7 @@ postTDeleteR tid ssh csh tutn = do
|
||||
return E.countRows
|
||||
return (course, tutorial, participants :: E.SqlExpr (E.Value Int))
|
||||
, drRenderRecord = \(Entity _ Course{..}, Entity _ Tutorial{..}, E.Value ps) ->
|
||||
return [whamlet|_{prependCourseTitle courseTerm courseSchool courseShorthand (CI.original tutorialName)} (#{tshow ps} _{MsgParticipantsN ps})|]
|
||||
return [whamlet|_{prependCourseTitle courseTerm courseSchool courseShorthand (CI.original tutorialName)} (_{MsgParticipantsN ps})|]
|
||||
, drRecordConfirmString = \(Entity _ Course{..}, Entity _ Tutorial{..}, E.Value ps) ->
|
||||
return [st|#{termToText (unTermKey courseTerm)}/#{unSchoolKey courseSchool}/#{courseShorthand}/#{tutorialName}+#{tshow ps}|]
|
||||
, drCaption = SomeMessage MsgTutorialDeleteQuestion
|
||||
@ -199,7 +199,7 @@ postTCommR tid ssh csh tutn = do
|
||||
[E.Value isTutorialUser] <- E.select . return . E.exists . E.from $ \tutorialUser ->
|
||||
E.where_ $ tutorialUser E.^. TutorialParticipantUser E.==. E.val uid
|
||||
E.&&. tutorialUser E.^. TutorialParticipantTutorial E.==. E.val tutid
|
||||
|
||||
|
||||
isAssociatedCorrector <- evalAccessForDB (Just uid) (CourseR tid ssh csh CNotesR) False
|
||||
isAssociatedTutor <- evalAccessForDB (Just uid) (CourseR tid ssh csh CTutorialListR) False
|
||||
|
||||
|
||||
45
src/Handler/Utils/Corrections.hs
Normal file
45
src/Handler/Utils/Corrections.hs
Normal file
@ -0,0 +1,45 @@
|
||||
module Handler.Utils.Corrections where
|
||||
|
||||
import Import
|
||||
|
||||
|
||||
-- CorrectionInfo has seeming redundancies, but these are useful for aggregation
|
||||
-- INVARIANT: isJust ciTot `implies` ciCorrected > 0
|
||||
data CorrectionInfo = CorrectionInfo
|
||||
{ ciSubmittors, ciSubmissions, ciAssigned, ciCorrected :: Integer
|
||||
, ciCorrector :: Maybe UserId
|
||||
, ciTot, ciMin, ciMax :: Maybe NominalDiffTime
|
||||
}
|
||||
|
||||
instance Semigroup CorrectionInfo where
|
||||
corrA <> corrB =
|
||||
assert (isJust (ciTot corrA) `implies` (ciCorrected corrA > 0)) $
|
||||
assert (isJust (ciTot corrB) `implies` (ciCorrected corrB > 0))
|
||||
CorrectionInfo
|
||||
{ ciSubmittors = ciSubmittors `mergeWith` (+)
|
||||
, ciSubmissions = ciSubmissions `mergeWith` (+)
|
||||
, ciAssigned = ciAssigned `mergeWith` (+)
|
||||
, ciCorrected = ciCorrected `mergeWith` (+)
|
||||
, ciCorrector = ciCorrector `mergeWith` keepEqual
|
||||
, ciTot = ciTot `mergeWith` ignoreNothing (+)
|
||||
, ciMin = ciMin `mergeWith` ignoreNothing min
|
||||
, ciMax = ciMax `mergeWith` ignoreNothing max
|
||||
}
|
||||
where
|
||||
mergeWith :: (CorrectionInfo -> a) -> (a -> a -> c) -> c
|
||||
mergeWith prj f = on f prj corrA corrB
|
||||
|
||||
keepEqual (Just x) (Just y) | x==y = Just x
|
||||
keepEqual _ _ = Nothing
|
||||
|
||||
instance Monoid CorrectionInfo where
|
||||
mappend = (<>)
|
||||
mempty = CorrectionInfo { ciSubmittors = 0
|
||||
, ciSubmissions = 0
|
||||
, ciAssigned = 0
|
||||
, ciCorrected = 0
|
||||
, ciCorrector = Nothing
|
||||
, ciMin = Nothing
|
||||
, ciTot = Nothing
|
||||
, ciMax = Nothing
|
||||
}
|
||||
@ -2,6 +2,7 @@ module Handler.Utils.DateTime
|
||||
( utcToLocalTime
|
||||
, localTimeToUTC, TZ.LocalToUTCResult(..)
|
||||
, toMidnight, beforeMidnight, toMidday, toMorning
|
||||
, formatDiffDays
|
||||
, formatTime, formatTime', formatTimeW
|
||||
, getTimeLocale, getDateTimeFormat
|
||||
, validDateTimeFormats, dateTimeFormatOptions
|
||||
@ -29,6 +30,37 @@ import qualified Data.Set as Set
|
||||
import Data.Time.Clock.System (systemEpochDay)
|
||||
|
||||
|
||||
|
||||
--------------------
|
||||
-- NominalDiffTime
|
||||
|
||||
-- | One hour in 'NominalDiffTime'.
|
||||
nominalHour :: NominalDiffTime
|
||||
nominalHour = 3600
|
||||
|
||||
-- | One minute in 'NominalDiffTime'.
|
||||
nominalMinute :: NominalDiffTime
|
||||
nominalMinute= 60
|
||||
|
||||
formatDiffDays :: NominalDiffTime -> Text
|
||||
formatDiffDays t
|
||||
| t > nominalDay = inDays <> "d"
|
||||
| t > nominalHour = inHours <> "h"
|
||||
| t > nominalMinute = inMinutes <> "m"
|
||||
| otherwise = tshow $ roundToDigits 0 t
|
||||
where
|
||||
convertBy :: NominalDiffTime -> Double
|
||||
convertBy len = realToFrac $ roundToDigits 1 $ t / len
|
||||
inDays = tshow $ convertBy nominalDay
|
||||
inHours = tshow $ convertBy nominalHour
|
||||
inMinutes = tshow $ convertBy nominalMinute
|
||||
|
||||
|
||||
|
||||
------------
|
||||
-- UTCTime
|
||||
|
||||
|
||||
utcToLocalTime :: UTCTime -> LocalTime
|
||||
utcToLocalTime = TZ.utcToLocalTimeTZ appTZ
|
||||
|
||||
@ -52,7 +84,6 @@ toMorning :: Day -> UTCTime
|
||||
toMorning d = localTimeToUTCTZ appTZ $ LocalTime d $ TimeOfDay 6 0 0
|
||||
|
||||
|
||||
|
||||
class FormatTime t => HasLocalTime t where
|
||||
toLocalTime :: t -> LocalTime
|
||||
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
module Handler.Utils.Submission
|
||||
( AssignSubmissionException(..)
|
||||
, assignSubmissions
|
||||
, assignSubmissions, writeSubmissionPlan, planSubmissions
|
||||
, submissionBlacklist, filterSubmission, extractRatings, extractRatingsMsg
|
||||
, submissionFileSource, submissionFileQuery
|
||||
, submissionMultiArchive
|
||||
@ -66,7 +66,32 @@ assignSubmissions :: SheetId -- ^ Sheet to distribute to correctors
|
||||
-> YesodDB UniWorX ( Set SubmissionId
|
||||
, Set SubmissionId
|
||||
) -- ^ Returns assigned and unassigned submissions; unassigned submissions occur only if no tutors have an assigned load
|
||||
assignSubmissions sid restriction = do
|
||||
assignSubmissions sid restriction = planSubmissions sid restriction >>= writeSubmissionPlan
|
||||
|
||||
-- | Assigns all submissions according to an already given assignment plan
|
||||
writeSubmissionPlan :: Map SubmissionId (Maybe UserId)
|
||||
-- ^ map that assigns submissions to correctors
|
||||
-> YesodDB UniWorX ( Set SubmissionId
|
||||
, Set SubmissionId
|
||||
) -- ^ Returns assigned and unassigned submissions; unassigned submissions occur only if no tutors have an assigned load
|
||||
writeSubmissionPlan newSubmissionData = do
|
||||
now <- liftIO getCurrentTime
|
||||
execWriterT . forM_ (Map.toList newSubmissionData) $ \(subId, mCorrector) -> case mCorrector of
|
||||
Just corrector -> do
|
||||
lift $ update subId [ SubmissionRatingBy =. Just corrector
|
||||
, SubmissionRatingAssigned =. Just now
|
||||
]
|
||||
tell (Set.singleton subId, mempty)
|
||||
Nothing ->
|
||||
tell (mempty, Set.singleton subId)
|
||||
|
||||
-- | Compute a map that shows which submissions ought the be assigned to each corrector according to sheet corrector loads, but does not alter database yet!
|
||||
-- May throw an exception if there are no suitable correctors
|
||||
planSubmissions :: SheetId -- ^ Sheet to distribute to correctors
|
||||
-> Maybe (Set SubmissionId) -- ^ Optionally restrict submission to consider
|
||||
-> YesodDB UniWorX (Map SubmissionId (Maybe UserId))
|
||||
-- ^ Return map that assigns submissions to Corrector
|
||||
planSubmissions sid restriction = do
|
||||
Sheet{..} <- getJust sid
|
||||
correctorsRaw <- E.select . E.from $ \(sheet `E.InnerJoin` sheetCorrector) -> do
|
||||
E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet
|
||||
@ -210,15 +235,7 @@ assignSubmissions sid restriction = do
|
||||
|
||||
ix subId . _1 <~ Just <$> liftIO (Rand.uniform bestCorrectors)
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
execWriterT . forM_ (Map.toList newSubmissionData) $ \(subId, (mCorrector, _, _)) -> case mCorrector of
|
||||
Just corrector -> do
|
||||
lift $ update subId [ SubmissionRatingBy =. Just corrector
|
||||
, SubmissionRatingAssigned =. Just now
|
||||
]
|
||||
tell (Set.singleton subId, mempty)
|
||||
Nothing ->
|
||||
tell (mempty, Set.singleton subId)
|
||||
return $ fmap (view _1) newSubmissionData
|
||||
where
|
||||
maximumsBy :: (Ord a, Ord b) => (a -> b) -> Set a -> Set a
|
||||
maximumsBy f xs = flip Set.filter xs $ \x -> maybe True (((==) `on` f) x . maximumBy (comparing f)) $ fromNullable xs
|
||||
|
||||
@ -305,3 +305,15 @@ instance Hashable CorrectorState
|
||||
nullaryPathPiece ''CorrectorState (camelToPathPiece' 1)
|
||||
|
||||
derivePersistField "CorrectorState"
|
||||
|
||||
showCompactCorrectorLoad :: Load -> CorrectorState -> Text
|
||||
showCompactCorrectorLoad load CorrectorMissing = "[" <> showCompactCorrectorLoad load CorrectorNormal <> "]"
|
||||
showCompactCorrectorLoad load CorrectorExcused = "{" <> showCompactCorrectorLoad load CorrectorNormal <> "}"
|
||||
showCompactCorrectorLoad Load{..} CorrectorNormal = proportionText <> tutorialText
|
||||
where
|
||||
proportionText = let propDbl :: Double
|
||||
propDbl = fromRational byProportion
|
||||
in tshow $ roundToDigits 2 propDbl
|
||||
tutorialText = case byTutorial of Nothing -> mempty
|
||||
Just True -> " (T)"
|
||||
Just False -> " +T "
|
||||
|
||||
41
src/Utils.hs
41
src/Utils.hs
@ -343,6 +343,17 @@ notUsedT = notUsed
|
||||
|
||||
|
||||
|
||||
----------
|
||||
-- Bool --
|
||||
----------
|
||||
|
||||
-- | Logical implication, readable synonym for (<=) which appears the wrong way around
|
||||
implies :: Bool -> Bool -> Bool
|
||||
implies True x = x
|
||||
implies _ _ = True
|
||||
|
||||
|
||||
|
||||
-------------
|
||||
-- Numeric --
|
||||
-------------
|
||||
@ -368,6 +379,19 @@ roundDiv :: (Integral a, Integral b, RealFrac c) => Int -> a -> b -> c
|
||||
roundDiv digits numerator denominator
|
||||
= roundToDigits digits $ fromIntegral numerator / fromIntegral denominator
|
||||
|
||||
-- | A value between 0 and 1, measuring how close `achieved` is to `full`; 0 meaning very and 1 meaning not at all
|
||||
-- `offset` specifies minimum result value, unless the goal is already achieved )i.e. full <= max(0,achieved)
|
||||
-- Useful for heat maps, with offset giving a visual step between completed and not yet completed
|
||||
cutOffPercent :: Double -> Double -> Double -> Double
|
||||
cutOffPercent offset full achieved
|
||||
| full <= achieved = 0
|
||||
| full <= 0 = 0
|
||||
| otherwise = offset + (1-offset) * (1 - percent)
|
||||
where
|
||||
percent = achieved / full
|
||||
|
||||
|
||||
|
||||
------------
|
||||
-- Monoid --
|
||||
------------
|
||||
@ -489,6 +513,11 @@ partMap = Map.fromListWith mappend
|
||||
invertMap :: (Ord k, Ord v) => Map k v -> Map v (Set k)
|
||||
invertMap = groupMap . map swap . Map.toList
|
||||
|
||||
-- | Counts how often a value appears in a map (not derived from invertMap for efficiency reasons)
|
||||
countMapElems :: (Ord v) => Map k v -> Map v Int
|
||||
countMapElems = Map.fromListWith (+) . map (\(_k,v)->(v,1)) . Map.toList
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
-- Functions --
|
||||
@ -523,12 +552,6 @@ flipMaybe :: b -> Maybe a -> Maybe b
|
||||
flipMaybe x Nothing = Just x
|
||||
flipMaybe _ (Just _) = Nothing
|
||||
|
||||
|
||||
maybeAdd :: Num a => Maybe a -> Maybe a -> Maybe a -- treats Nothing as neutral/zero, unlike fmap/ap
|
||||
maybeAdd (Just x) (Just y) = Just (x + y)
|
||||
maybeAdd Nothing y = y
|
||||
maybeAdd x Nothing = x
|
||||
|
||||
-- | Deep alternative to avoid any occurrence of Nothing at all costs, left-biased
|
||||
deepAlt :: Maybe (Maybe a) -> Maybe (Maybe a) -> Maybe (Maybe a)
|
||||
deepAlt Nothing altSnd = altSnd
|
||||
@ -574,6 +597,12 @@ mcons :: Maybe a -> [a] -> [a]
|
||||
mcons Nothing xs = xs
|
||||
mcons (Just x) xs = x:xs
|
||||
|
||||
-- | apply binary function to maybes, but ignores Nothing by using id if possible, unlike fmap/ap
|
||||
ignoreNothing :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
|
||||
ignoreNothing _ Nothing y = y
|
||||
ignoreNothing _ x Nothing = x
|
||||
ignoreNothing f (Just x) (Just y) = Just $ f x y
|
||||
|
||||
newtype NTop a = NTop { nBot :: a } -- treat Nothing as Top for Ord (Maybe a); default implementation treats Nothing as bottom
|
||||
|
||||
instance Eq a => Eq (NTop (Maybe a)) where
|
||||
|
||||
@ -364,10 +364,11 @@ buttonView btn = do
|
||||
fieldView bField btnId "" mempty (Right btn) False
|
||||
|
||||
|
||||
|
||||
-- | generate a form that only shows a finite amount of buttons
|
||||
buttonForm :: (Button site a, Finite a) => Html -> MForm (HandlerT site IO) (FormResult a, WidgetT site IO ())
|
||||
buttonForm = buttonForm' universeF
|
||||
|
||||
-- | like `buttonForm`, but for a given list of buttons, i.e. a subset or for buttons outside the Finite typeclass
|
||||
buttonForm' :: Button site a => [a] -> Html -> MForm (HandlerT site IO) (FormResult a, WidgetT site IO ())
|
||||
buttonForm' btns csrf = do
|
||||
(res, ($ []) -> fViews) <- aFormToForm . disambiguateButtons $ combinedButtonField btns ""
|
||||
@ -378,6 +379,35 @@ buttonForm' btns csrf = do
|
||||
^{fvInput bView}
|
||||
|])
|
||||
|
||||
-- | buttons-only form complete with widget-generation and evaluation; return type determines buttons shown.
|
||||
runButtonForm ::(PathPiece ident, Eq ident, RenderMessage site FormMessage,
|
||||
Button site ButtonSubmit, Button site a, Finite a)
|
||||
=> ident -> HandlerT site IO (WidgetT site IO (), Maybe a)
|
||||
runButtonForm fid = do
|
||||
currentRoute <- getCurrentRoute
|
||||
((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm fid buttonForm
|
||||
let btnForm = wrapForm btnWdgt def { formAction = SomeRoute <$> currentRoute
|
||||
, formEncoding = btnEnctype
|
||||
, formSubmit = FormNoSubmit
|
||||
}
|
||||
res <- formResultMaybe btnResult (return . Just)
|
||||
return (btnForm, res)
|
||||
|
||||
-- | like `runButtonForm` but showing only a given list of buttons, especially for buttons that are not in the Finite typeclass.
|
||||
runButtonForm' ::(PathPiece ident, Eq ident, RenderMessage site FormMessage,
|
||||
Button site ButtonSubmit, Button site a)
|
||||
=> [a] -> ident -> HandlerT site IO (WidgetT site IO (), Maybe a)
|
||||
runButtonForm' btns fid = do
|
||||
currentRoute <- getCurrentRoute
|
||||
((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm fid $ buttonForm' btns
|
||||
let btnForm = wrapForm btnWdgt def { formAction = SomeRoute <$> currentRoute
|
||||
, formEncoding = btnEnctype
|
||||
, formSubmit = FormNoSubmit
|
||||
}
|
||||
res <- formResultMaybe btnResult (return . Just)
|
||||
return (btnForm, res)
|
||||
|
||||
|
||||
-------------------
|
||||
-- Custom Fields --
|
||||
-------------------
|
||||
|
||||
77
templates/corrections-overview.hamlet
Normal file
77
templates/corrections-overview.hamlet
Normal file
@ -0,0 +1,77 @@
|
||||
<div>
|
||||
<h2>_{MsgCorrectionSheets}
|
||||
_{MsgCourseParticipants nrParticipants}
|
||||
<table .table .table--striped .table--hover>
|
||||
<tr .table__row .table__row--head>
|
||||
<th .table__th>_{MsgSheet}
|
||||
$if groupsPossible
|
||||
<th .table__th>_{MsgNrSubmittorsTotal}
|
||||
<th .table__th >_{MsgNrSubmissionsTotal}
|
||||
<th .table__th colspan=2>_{MsgNrSubmissionsNotAssigned}
|
||||
<th .table__th>_{MsgNrSubmissionsNotCorrected}
|
||||
<th .table__th colspan=3>_{MsgCorrectionTime}
|
||||
$forall (sheetName, CorrectionInfo{ciSubmittors, ciSubmissions, ciAssigned, ciCorrected, ciMin, ciTot, ciMax}) <- Map.toList sheetMap
|
||||
<tr .table__row>
|
||||
<td .table__td>^{simpleLink (toWidget sheetName) (CSheetR tid ssh csh sheetName SSubsR)}
|
||||
$if groupsPossible
|
||||
<td .table__td>#{ciSubmittors}
|
||||
<td .table__td>#{ciSubmissions}
|
||||
$maybe ((splus,sfailed),_) <- Map.lookup sheetName assignment
|
||||
$if 0 < Set.size sfailed
|
||||
<td .table__td>#{ciSubmissions - ciAssigned}
|
||||
<td .table__td .alert-danger>(-#{show (Set.size splus)}, failed: #{show (Set.size sfailed)})
|
||||
$elseif 0 < Set.size splus
|
||||
<td .table__td>#{ciSubmissions - ciAssigned}
|
||||
<td .table__td .alert-info>(-#{show (Set.size splus)})
|
||||
$else
|
||||
<td .table__td colspan=2>#{ciSubmissions - ciAssigned}
|
||||
$nothing
|
||||
<td .table__td colspan=2>#{ciSubmissions - ciAssigned}
|
||||
<td .table__td>#{ciSubmissions - ciCorrected}
|
||||
<td .table__td>#{showDiffDays ciMin}
|
||||
<td .table__td>#{showAvgsDays ciTot ciCorrected}
|
||||
<td .table__td>#{showDiffDays ciMax}
|
||||
<div>
|
||||
<h2>_{MsgCorrectionCorrectors}
|
||||
<table .table .table--striped .table--hover>
|
||||
<tr .table__row .table__row--head>
|
||||
<th .table__th>_{MsgCorrector}
|
||||
<th .table__th>_{MsgNrSubmissionsTotal}
|
||||
<th .table__th>_{MsgNrSubmissionsNotCorrected}
|
||||
<th .table__th colspan=3>_{MsgCorrectionTime}
|
||||
$forall shn <- sheetNames
|
||||
<th .table__th colspan=5>#{shn}
|
||||
$# ^{simpleLinkI (SomeMessage MsgMenuCorrectors) (CSheetR tid ssh csh shn SCorrR)}
|
||||
$forall (CorrectionInfo{ciCorrector, ciSubmissions, ciCorrected, ciMin, ciTot, ciMax}) <- Map.elems corrMap
|
||||
$with (nameW,loadM) <- getCorrector ciCorrector
|
||||
<tr .table__row>
|
||||
<td .table__td>^{nameW}
|
||||
<td .table__td>#{ciSubmissions}
|
||||
<td .table__td .heated style="--hotness: #{heat ciSubmissions ciCorrected}">#{ciSubmissions - ciCorrected}
|
||||
<td .table__td>#{showDiffDays ciMin}
|
||||
<td .table__td>#{showAvgsDays ciTot ciCorrected}
|
||||
<td .table__td>#{showDiffDays ciMax}
|
||||
$forall shn <- sheetNames
|
||||
$maybe SheetCorrector{sheetCorrectorLoad, sheetCorrectorState} <- Map.lookup shn loadM
|
||||
<td .table__td>#{showCompactCorrectorLoad sheetCorrectorLoad sheetCorrectorState}
|
||||
$nothing
|
||||
<td .table__td>
|
||||
$maybe CorrectionInfo{ciSubmissions,ciCorrected,ciTot} <- getCorrSheetStatus ciCorrector shn
|
||||
$maybe nrNew <- getCorrNewAssignment ciCorrector shn
|
||||
<td .table__td>#{ciSubmissions}
|
||||
$# <td .table__td>#{ciAssigned} `ciSubmissions` is here always identical to `ciAssigned` and also works for `ciCorrector == Nothing`. ciAssigned only useful in aggregate maps like `sheetMap`
|
||||
<td .table__td .alert-info>(+#{nrNew})
|
||||
$nothing
|
||||
<td .table__td colspan=2>#{ciSubmissions}
|
||||
<td .table__td .heated style="--hotness: #{heat ciSubmissions ciCorrected}">#{ciSubmissions - ciCorrected}
|
||||
<td .table__td>#{showAvgsDays ciTot ciCorrected}
|
||||
$nothing
|
||||
<td .table__td colspan=4>
|
||||
$if 0 < length sheetNames
|
||||
<tr .table__row>
|
||||
<td colspan=6>
|
||||
$forall shn <- sheetNames
|
||||
<td .table__td colspan=5>^{simpleLinkI (SomeMessage MsgMenuCorrectors) (CSheetR tid ssh csh shn SCorrR)}
|
||||
^{btnWdgt}
|
||||
<div>
|
||||
<p>_{MsgAssignSubmissionsRandomWarning}
|
||||
@ -565,6 +565,7 @@ section {
|
||||
color: var(--color-dark);
|
||||
box-shadow: 0 0 4px 2px inset currentColor;
|
||||
padding-left: 20%;
|
||||
min-height: 100px;
|
||||
|
||||
&::before {
|
||||
content: 'i';
|
||||
@ -579,6 +580,10 @@ section {
|
||||
justify-content: center;
|
||||
}
|
||||
}
|
||||
|
||||
.form-group__input > .notification {
|
||||
margin: 0;
|
||||
}
|
||||
|
||||
@media (max-width: 768px) {
|
||||
|
||||
@ -606,3 +611,29 @@ section {
|
||||
.notification__content {
|
||||
color: var(--color-font);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
/*
|
||||
"Heated" element.
|
||||
Set custom property "--hotness" to a value from 0 to 1 to turn
|
||||
the element's background to a color on a gradient from green to red.
|
||||
|
||||
TBD:
|
||||
- move to a proper place
|
||||
- think about font-weight...
|
||||
|
||||
Example:
|
||||
<div .heated style="--hotness: 0.2">Lorem ipsum
|
||||
*/
|
||||
|
||||
.heated {
|
||||
--hotness: 0;
|
||||
--red: calc(var(--hotness) * 200);
|
||||
--green: calc(255 - calc(var(--hotness) * 255));
|
||||
--opacity: calc(calc(var(--red) / 600) + 0.1);
|
||||
|
||||
font-weight: var(--weight, 600);
|
||||
background-color: rgba(var(--red), var(--green), 0, var(--opacity));
|
||||
}
|
||||
|
||||
@ -2,6 +2,10 @@ $newline never
|
||||
$if null rows && (dbsEmptyStyle == DBESNoHeading)
|
||||
_{dbsEmptyMessage}
|
||||
$else
|
||||
<div .table-header>
|
||||
<div .table__row-count>
|
||||
_{MsgRowCount rowCount}
|
||||
|
||||
^{table}
|
||||
|
||||
<div .table-footer>
|
||||
|
||||
@ -1,3 +1,10 @@
|
||||
/* TABLE HEADER */
|
||||
.table-header {
|
||||
display: flex;
|
||||
flex-flow: row-reverse;
|
||||
justify-content: space-between;
|
||||
}
|
||||
|
||||
/* TABLE FOOTER */
|
||||
.table-footer {
|
||||
display: flex;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user