Merge branch 'master' into course-teaser-ui
This commit is contained in:
Gregor Kleen
commit
cc0f79ec31
3
.babelrc
3
.babelrc
@ -4,6 +4,7 @@
|
||||
],
|
||||
"plugins": [
|
||||
["@babel/plugin-proposal-decorators", { "legacy": true }],
|
||||
["@babel/plugin-proposal-class-properties", { "loose": true }]
|
||||
["@babel/plugin-proposal-class-properties", { "loose": true }],
|
||||
["@babel/transform-runtime"]
|
||||
]
|
||||
}
|
||||
|
||||
5
.vscode/tasks.json
vendored
5
.vscode/tasks.json
vendored
@ -69,6 +69,11 @@
|
||||
"type": "npm",
|
||||
"script": "lint",
|
||||
"problemMatcher": []
|
||||
},
|
||||
{
|
||||
"type": "npm",
|
||||
"script": "release",
|
||||
"problemMatcher": []
|
||||
}
|
||||
]
|
||||
}
|
||||
104
CHANGELOG.md
104
CHANGELOG.md
@ -2,6 +2,110 @@
|
||||
|
||||
All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.
|
||||
|
||||
## [5.5.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.4.0...v5.5.0) (2019-08-27)
|
||||
|
||||
|
||||
### Bug Fixes
|
||||
|
||||
* **changelog:** add date ([52a88f8](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/52a88f8))
|
||||
* **course-applications-csv:** record rating time ([c2c6974](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/c2c6974))
|
||||
|
||||
|
||||
### Features
|
||||
|
||||
* optional ribbon ([c2e13cf](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/c2e13cf))
|
||||
|
||||
|
||||
|
||||
## [5.4.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.3.0...v5.4.0) (2019-08-27)
|
||||
|
||||
|
||||
### Bug Fixes
|
||||
|
||||
* **course-edit:** only show allocation error message when relevant ([00a6ca8](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/00a6ca8))
|
||||
|
||||
|
||||
### Features
|
||||
|
||||
* **allocations:** serve archive of all application files by course ([5e393c5](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/5e393c5))
|
||||
* allow editing of course applications outside of allocation ([e816a30](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/e816a30))
|
||||
* **course-applications:** csv transport ([cf0ec1a](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/cf0ec1a))
|
||||
|
||||
|
||||
|
||||
## [5.3.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.2.3...v5.3.0) (2019-08-22)
|
||||
|
||||
|
||||
### Bug Fixes
|
||||
|
||||
* **allocations:** fix behaviour of "active" dbTable-filter ([b694a09](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/b694a09))
|
||||
* **course list:** show complete registration span ([754d6ca](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/754d6ca)), closes [#446](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/issues/446)
|
||||
* **home:** fix hlint and other minor bugs ([839251e](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/839251e))
|
||||
|
||||
|
||||
### Features
|
||||
|
||||
* **allocations:** add info page for allocations ([689b85a](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/689b85a))
|
||||
* **allocations:** show table of all allocations ([d621e61](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/d621e61))
|
||||
* **allocations:** show table of course applications ([f5da3be](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/f5da3be))
|
||||
* **home:** allow users to define exam warning time ([d23e222](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/d23e222)), closes [#445](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/issues/445)
|
||||
* **home:** clean up homepage ([a6e2f64](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/a6e2f64))
|
||||
|
||||
|
||||
|
||||
### [5.2.3](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.2.2...v5.2.3) (2019-08-22)
|
||||
|
||||
|
||||
### Bug Fixes
|
||||
|
||||
* **csv exam import:** ignore unchanged noshow and voided ([a346524](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/a346524))
|
||||
|
||||
|
||||
|
||||
### [5.2.2](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.2.1...v5.2.2) (2019-08-22)
|
||||
|
||||
|
||||
|
||||
### [5.2.1](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.2.0...v5.2.1) (2019-08-21)
|
||||
|
||||
|
||||
### Bug Fixes
|
||||
|
||||
* **csv upload exams:** allow ambiguous harmless study fields ([7d2937c](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/7d2937c))
|
||||
|
||||
|
||||
|
||||
## [5.2.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.1.0...v5.2.0) (2019-08-21)
|
||||
|
||||
|
||||
### Bug Fixes
|
||||
|
||||
* **csv import:** csv import preview help text adjusted ([b7321df](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/b7321df))
|
||||
* **csv import:** fix spelling and expand help text ([2c57a77](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/2c57a77))
|
||||
* **exam import:** inactive registered features may be selected ([3c4172c](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/3c4172c))
|
||||
* **routes:** change ex to sheet ([9d9ead9](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/9d9ead9))
|
||||
* **sheet list:** do not show icons for inaccessible items ([0bb9a0f](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/0bb9a0f)), closes [#421](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/issues/421)
|
||||
|
||||
|
||||
### Features
|
||||
|
||||
* **csv import:** add explanation text ([6d0a4c1](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/6d0a4c1))
|
||||
|
||||
|
||||
|
||||
## [5.1.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.0.2...v5.1.0) (2019-08-19)
|
||||
|
||||
|
||||
### Features
|
||||
|
||||
* **allocations:** add application form(s) ([ef625cd](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/ef625cd))
|
||||
* **allocations:** add registration form ([c5b18fc](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/c5b18fc))
|
||||
* **allocations:** implement application interface ([4dcc82a](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/4dcc82a))
|
||||
* **allocations:** link allocations from home ([c759364](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/c759364))
|
||||
* **allocations:** set up routes ([c2df01c](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/c2df01c))
|
||||
|
||||
|
||||
|
||||
### [5.0.2](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.0.1...v5.0.2) (2019-08-13)
|
||||
|
||||
|
||||
|
||||
@ -41,6 +41,9 @@ health-check-delay-notify: "_env:HEALTHCHECK_DELAY_NOTIFY:true"
|
||||
health-check-http: "_env:HEALTHCHECK_HTTP:true" # Can we assume, that we can reach ourselves under APPROOT via HTTP (reverse proxies or firewalls might prevent this)?
|
||||
health-check-active-job-executors-timeout: "_env:HEALTHCHECK_ACTIVE_JOB_EXECUTORS_TIMEOUT:5"
|
||||
|
||||
synchronise-ldap-users-within: "_env:SYNCHRONISE_LDAP_WITHIN:604800"
|
||||
synchronise-ldap-users-interval: "_env:SYNCHRONISE_LDAP_INTERVAL:3600"
|
||||
|
||||
log-settings:
|
||||
detailed: "_env:DETAILED_LOGGING:false"
|
||||
all: "_env:LOG_ALL:false"
|
||||
@ -119,5 +122,7 @@ user-defaults:
|
||||
date-format: "%d.%m.%Y"
|
||||
time-format: "%R"
|
||||
download-files: false
|
||||
warning-days: 1209600
|
||||
|
||||
instance-id: "_env:INSTANCE_ID:instance"
|
||||
ribbon: "_env:RIBBON:"
|
||||
|
||||
@ -1,466 +0,0 @@
|
||||
(function(self) {
|
||||
'use strict';
|
||||
|
||||
if (self.fetch) {
|
||||
return
|
||||
}
|
||||
|
||||
var support = {
|
||||
searchParams: 'URLSearchParams' in self,
|
||||
iterable: 'Symbol' in self && 'iterator' in Symbol,
|
||||
blob: 'FileReader' in self && 'Blob' in self && (function() {
|
||||
try {
|
||||
new Blob()
|
||||
return true
|
||||
} catch(e) {
|
||||
return false
|
||||
}
|
||||
})(),
|
||||
formData: 'FormData' in self,
|
||||
arrayBuffer: 'ArrayBuffer' in self
|
||||
}
|
||||
|
||||
if (support.arrayBuffer) {
|
||||
var viewClasses = [
|
||||
'[object Int8Array]',
|
||||
'[object Uint8Array]',
|
||||
'[object Uint8ClampedArray]',
|
||||
'[object Int16Array]',
|
||||
'[object Uint16Array]',
|
||||
'[object Int32Array]',
|
||||
'[object Uint32Array]',
|
||||
'[object Float32Array]',
|
||||
'[object Float64Array]'
|
||||
]
|
||||
|
||||
var isDataView = function(obj) {
|
||||
return obj && DataView.prototype.isPrototypeOf(obj)
|
||||
}
|
||||
|
||||
var isArrayBufferView = ArrayBuffer.isView || function(obj) {
|
||||
return obj && viewClasses.indexOf(Object.prototype.toString.call(obj)) > -1
|
||||
}
|
||||
}
|
||||
|
||||
function normalizeName(name) {
|
||||
if (typeof name !== 'string') {
|
||||
name = String(name)
|
||||
}
|
||||
if (/[^a-z0-9\-#$%&'*+.\^_`|~]/i.test(name)) {
|
||||
throw new TypeError('Invalid character in header field name')
|
||||
}
|
||||
return name.toLowerCase()
|
||||
}
|
||||
|
||||
function normalizeValue(value) {
|
||||
if (typeof value !== 'string') {
|
||||
value = String(value)
|
||||
}
|
||||
return value
|
||||
}
|
||||
|
||||
// Build a destructive iterator for the value list
|
||||
function iteratorFor(items) {
|
||||
var iterator = {
|
||||
next: function() {
|
||||
var value = items.shift()
|
||||
return {done: value === undefined, value: value}
|
||||
}
|
||||
}
|
||||
|
||||
if (support.iterable) {
|
||||
iterator[Symbol.iterator] = function() {
|
||||
return iterator
|
||||
}
|
||||
}
|
||||
|
||||
return iterator
|
||||
}
|
||||
|
||||
function Headers(headers) {
|
||||
this.map = {}
|
||||
|
||||
if (headers instanceof Headers) {
|
||||
headers.forEach(function(value, name) {
|
||||
this.append(name, value)
|
||||
}, this)
|
||||
} else if (Array.isArray(headers)) {
|
||||
headers.forEach(function(header) {
|
||||
this.append(header[0], header[1])
|
||||
}, this)
|
||||
} else if (headers) {
|
||||
Object.getOwnPropertyNames(headers).forEach(function(name) {
|
||||
this.append(name, headers[name])
|
||||
}, this)
|
||||
}
|
||||
}
|
||||
|
||||
Headers.prototype.append = function(name, value) {
|
||||
name = normalizeName(name)
|
||||
value = normalizeValue(value)
|
||||
var oldValue = this.map[name]
|
||||
this.map[name] = oldValue ? oldValue+','+value : value
|
||||
}
|
||||
|
||||
Headers.prototype['delete'] = function(name) {
|
||||
delete this.map[normalizeName(name)]
|
||||
}
|
||||
|
||||
Headers.prototype.get = function(name) {
|
||||
name = normalizeName(name)
|
||||
return this.has(name) ? this.map[name] : null
|
||||
}
|
||||
|
||||
Headers.prototype.has = function(name) {
|
||||
return this.map.hasOwnProperty(normalizeName(name))
|
||||
}
|
||||
|
||||
Headers.prototype.set = function(name, value) {
|
||||
this.map[normalizeName(name)] = normalizeValue(value)
|
||||
}
|
||||
|
||||
Headers.prototype.forEach = function(callback, thisArg) {
|
||||
for (var name in this.map) {
|
||||
if (this.map.hasOwnProperty(name)) {
|
||||
callback.call(thisArg, this.map[name], name, this)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
Headers.prototype.keys = function() {
|
||||
var items = []
|
||||
this.forEach(function(value, name) { items.push(name) })
|
||||
return iteratorFor(items)
|
||||
}
|
||||
|
||||
Headers.prototype.values = function() {
|
||||
var items = []
|
||||
this.forEach(function(value) { items.push(value) })
|
||||
return iteratorFor(items)
|
||||
}
|
||||
|
||||
Headers.prototype.entries = function() {
|
||||
var items = []
|
||||
this.forEach(function(value, name) { items.push([name, value]) })
|
||||
return iteratorFor(items)
|
||||
}
|
||||
|
||||
if (support.iterable) {
|
||||
Headers.prototype[Symbol.iterator] = Headers.prototype.entries
|
||||
}
|
||||
|
||||
function consumed(body) {
|
||||
if (body.bodyUsed) {
|
||||
return Promise.reject(new TypeError('Already read'))
|
||||
}
|
||||
body.bodyUsed = true
|
||||
}
|
||||
|
||||
function fileReaderReady(reader) {
|
||||
return new Promise(function(resolve, reject) {
|
||||
reader.onload = function() {
|
||||
resolve(reader.result)
|
||||
}
|
||||
reader.onerror = function() {
|
||||
reject(reader.error)
|
||||
}
|
||||
})
|
||||
}
|
||||
|
||||
function readBlobAsArrayBuffer(blob) {
|
||||
var reader = new FileReader()
|
||||
var promise = fileReaderReady(reader)
|
||||
reader.readAsArrayBuffer(blob)
|
||||
return promise
|
||||
}
|
||||
|
||||
function readBlobAsText(blob) {
|
||||
var reader = new FileReader()
|
||||
var promise = fileReaderReady(reader)
|
||||
reader.readAsText(blob)
|
||||
return promise
|
||||
}
|
||||
|
||||
function readArrayBufferAsText(buf) {
|
||||
var view = new Uint8Array(buf)
|
||||
var chars = new Array(view.length)
|
||||
|
||||
for (var i = 0; i < view.length; i++) {
|
||||
chars[i] = String.fromCharCode(view[i])
|
||||
}
|
||||
return chars.join('')
|
||||
}
|
||||
|
||||
function bufferClone(buf) {
|
||||
if (buf.slice) {
|
||||
return buf.slice(0)
|
||||
} else {
|
||||
var view = new Uint8Array(buf.byteLength)
|
||||
view.set(new Uint8Array(buf))
|
||||
return view.buffer
|
||||
}
|
||||
}
|
||||
|
||||
function Body() {
|
||||
this.bodyUsed = false
|
||||
|
||||
this._initBody = function(body) {
|
||||
this._bodyInit = body
|
||||
if (!body) {
|
||||
this._bodyText = ''
|
||||
} else if (typeof body === 'string') {
|
||||
this._bodyText = body
|
||||
} else if (support.blob && Blob.prototype.isPrototypeOf(body)) {
|
||||
this._bodyBlob = body
|
||||
} else if (support.formData && FormData.prototype.isPrototypeOf(body)) {
|
||||
this._bodyFormData = body
|
||||
} else if (support.searchParams && URLSearchParams.prototype.isPrototypeOf(body)) {
|
||||
this._bodyText = body.toString()
|
||||
} else if (support.arrayBuffer && support.blob && isDataView(body)) {
|
||||
this._bodyArrayBuffer = bufferClone(body.buffer)
|
||||
// IE 10-11 can't handle a DataView body.
|
||||
this._bodyInit = new Blob([this._bodyArrayBuffer])
|
||||
} else if (support.arrayBuffer && (ArrayBuffer.prototype.isPrototypeOf(body) || isArrayBufferView(body))) {
|
||||
this._bodyArrayBuffer = bufferClone(body)
|
||||
} else {
|
||||
throw new Error('unsupported BodyInit type')
|
||||
}
|
||||
|
||||
if (!this.headers.get('content-type')) {
|
||||
if (typeof body === 'string') {
|
||||
this.headers.set('content-type', 'text/plain;charset=UTF-8')
|
||||
} else if (this._bodyBlob && this._bodyBlob.type) {
|
||||
this.headers.set('content-type', this._bodyBlob.type)
|
||||
} else if (support.searchParams && URLSearchParams.prototype.isPrototypeOf(body)) {
|
||||
this.headers.set('content-type', 'application/x-www-form-urlencoded;charset=UTF-8')
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (support.blob) {
|
||||
this.blob = function() {
|
||||
var rejected = consumed(this)
|
||||
if (rejected) {
|
||||
return rejected
|
||||
}
|
||||
|
||||
if (this._bodyBlob) {
|
||||
return Promise.resolve(this._bodyBlob)
|
||||
} else if (this._bodyArrayBuffer) {
|
||||
return Promise.resolve(new Blob([this._bodyArrayBuffer]))
|
||||
} else if (this._bodyFormData) {
|
||||
throw new Error('could not read FormData body as blob')
|
||||
} else {
|
||||
return Promise.resolve(new Blob([this._bodyText]))
|
||||
}
|
||||
}
|
||||
|
||||
this.arrayBuffer = function() {
|
||||
if (this._bodyArrayBuffer) {
|
||||
return consumed(this) || Promise.resolve(this._bodyArrayBuffer)
|
||||
} else {
|
||||
return this.blob().then(readBlobAsArrayBuffer)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
this.text = function() {
|
||||
var rejected = consumed(this)
|
||||
if (rejected) {
|
||||
return rejected
|
||||
}
|
||||
|
||||
if (this._bodyBlob) {
|
||||
return readBlobAsText(this._bodyBlob)
|
||||
} else if (this._bodyArrayBuffer) {
|
||||
return Promise.resolve(readArrayBufferAsText(this._bodyArrayBuffer))
|
||||
} else if (this._bodyFormData) {
|
||||
throw new Error('could not read FormData body as text')
|
||||
} else {
|
||||
return Promise.resolve(this._bodyText)
|
||||
}
|
||||
}
|
||||
|
||||
if (support.formData) {
|
||||
this.formData = function() {
|
||||
return this.text().then(decode)
|
||||
}
|
||||
}
|
||||
|
||||
this.json = function() {
|
||||
return this.text().then(JSON.parse)
|
||||
}
|
||||
|
||||
return this
|
||||
}
|
||||
|
||||
// HTTP methods whose capitalization should be normalized
|
||||
var methods = ['DELETE', 'GET', 'HEAD', 'OPTIONS', 'POST', 'PUT']
|
||||
|
||||
function normalizeMethod(method) {
|
||||
var upcased = method.toUpperCase()
|
||||
return (methods.indexOf(upcased) > -1) ? upcased : method
|
||||
}
|
||||
|
||||
function Request(input, options) {
|
||||
options = options || {}
|
||||
var body = options.body
|
||||
|
||||
if (input instanceof Request) {
|
||||
if (input.bodyUsed) {
|
||||
throw new TypeError('Already read')
|
||||
}
|
||||
this.url = input.url
|
||||
this.credentials = input.credentials
|
||||
if (!options.headers) {
|
||||
this.headers = new Headers(input.headers)
|
||||
}
|
||||
this.method = input.method
|
||||
this.mode = input.mode
|
||||
if (!body && input._bodyInit != null) {
|
||||
body = input._bodyInit
|
||||
input.bodyUsed = true
|
||||
}
|
||||
} else {
|
||||
this.url = String(input)
|
||||
}
|
||||
|
||||
this.credentials = options.credentials || this.credentials || 'omit'
|
||||
if (options.headers || !this.headers) {
|
||||
this.headers = new Headers(options.headers)
|
||||
}
|
||||
this.method = normalizeMethod(options.method || this.method || 'GET')
|
||||
this.mode = options.mode || this.mode || null
|
||||
this.referrer = null
|
||||
|
||||
if ((this.method === 'GET' || this.method === 'HEAD') && body) {
|
||||
throw new TypeError('Body not allowed for GET or HEAD requests')
|
||||
}
|
||||
this._initBody(body)
|
||||
}
|
||||
|
||||
Request.prototype.clone = function() {
|
||||
return new Request(this, { body: this._bodyInit })
|
||||
}
|
||||
|
||||
function decode(body) {
|
||||
var form = new FormData()
|
||||
body.trim().split('&').forEach(function(bytes) {
|
||||
if (bytes) {
|
||||
var split = bytes.split('=')
|
||||
var name = split.shift().replace(/\+/g, ' ')
|
||||
var value = split.join('=').replace(/\+/g, ' ')
|
||||
form.append(decodeURIComponent(name), decodeURIComponent(value))
|
||||
}
|
||||
})
|
||||
return form
|
||||
}
|
||||
|
||||
function parseHeaders(rawHeaders) {
|
||||
var headers = new Headers()
|
||||
// Replace instances of \r\n and \n followed by at least one space or horizontal tab with a space
|
||||
// https://tools.ietf.org/html/rfc7230#section-3.2
|
||||
var preProcessedHeaders = rawHeaders.replace(/\r?\n[\t ]+/g, ' ')
|
||||
preProcessedHeaders.split(/\r?\n/).forEach(function(line) {
|
||||
var parts = line.split(':')
|
||||
var key = parts.shift().trim()
|
||||
if (key) {
|
||||
var value = parts.join(':').trim()
|
||||
headers.append(key, value)
|
||||
}
|
||||
})
|
||||
return headers
|
||||
}
|
||||
|
||||
Body.call(Request.prototype)
|
||||
|
||||
function Response(bodyInit, options) {
|
||||
if (!options) {
|
||||
options = {}
|
||||
}
|
||||
|
||||
this.type = 'default'
|
||||
this.status = options.status === undefined ? 200 : options.status
|
||||
this.ok = this.status >= 200 && this.status < 300
|
||||
this.statusText = 'statusText' in options ? options.statusText : 'OK'
|
||||
this.headers = new Headers(options.headers)
|
||||
this.url = options.url || ''
|
||||
this._initBody(bodyInit)
|
||||
}
|
||||
|
||||
Body.call(Response.prototype)
|
||||
|
||||
Response.prototype.clone = function() {
|
||||
return new Response(this._bodyInit, {
|
||||
status: this.status,
|
||||
statusText: this.statusText,
|
||||
headers: new Headers(this.headers),
|
||||
url: this.url
|
||||
})
|
||||
}
|
||||
|
||||
Response.error = function() {
|
||||
var response = new Response(null, {status: 0, statusText: ''})
|
||||
response.type = 'error'
|
||||
return response
|
||||
}
|
||||
|
||||
var redirectStatuses = [301, 302, 303, 307, 308]
|
||||
|
||||
Response.redirect = function(url, status) {
|
||||
if (redirectStatuses.indexOf(status) === -1) {
|
||||
throw new RangeError('Invalid status code')
|
||||
}
|
||||
|
||||
return new Response(null, {status: status, headers: {location: url}})
|
||||
}
|
||||
|
||||
self.Headers = Headers
|
||||
self.Request = Request
|
||||
self.Response = Response
|
||||
|
||||
self.fetch = function(input, init) {
|
||||
return new Promise(function(resolve, reject) {
|
||||
var request = new Request(input, init)
|
||||
var xhr = new XMLHttpRequest()
|
||||
|
||||
xhr.onload = function() {
|
||||
var options = {
|
||||
status: xhr.status,
|
||||
statusText: xhr.statusText,
|
||||
headers: parseHeaders(xhr.getAllResponseHeaders() || '')
|
||||
}
|
||||
options.url = 'responseURL' in xhr ? xhr.responseURL : options.headers.get('X-Request-URL')
|
||||
var body = 'response' in xhr ? xhr.response : xhr.responseText
|
||||
resolve(new Response(body, options))
|
||||
}
|
||||
|
||||
xhr.onerror = function() {
|
||||
reject(new TypeError('Network request failed'))
|
||||
}
|
||||
|
||||
xhr.ontimeout = function() {
|
||||
reject(new TypeError('Network request failed'))
|
||||
}
|
||||
|
||||
xhr.open(request.method, request.url, true)
|
||||
|
||||
if (request.credentials === 'include') {
|
||||
xhr.withCredentials = true
|
||||
} else if (request.credentials === 'omit') {
|
||||
xhr.withCredentials = false
|
||||
}
|
||||
|
||||
if ('responseType' in xhr && support.blob) {
|
||||
xhr.responseType = 'blob'
|
||||
}
|
||||
|
||||
request.headers.forEach(function(value, name) {
|
||||
xhr.setRequestHeader(name, value)
|
||||
})
|
||||
|
||||
xhr.send(typeof request._bodyInit === 'undefined' ? null : request._bodyInit)
|
||||
})
|
||||
}
|
||||
self.fetch.polyfill = true
|
||||
})(typeof self !== 'undefined' ? self : this);
|
||||
@ -1,2 +0,0 @@
|
||||
import './fetch';
|
||||
import './url-search-params';
|
||||
@ -1,348 +0,0 @@
|
||||
(function(global) {
|
||||
/**
|
||||
* Polyfill URLSearchParams
|
||||
*
|
||||
* Inspired from : https://github.com/WebReflection/url-search-params/blob/master/src/url-search-params.js
|
||||
*/
|
||||
|
||||
var checkIfIteratorIsSupported = function() {
|
||||
try {
|
||||
return !!Symbol.iterator;
|
||||
} catch(error) {
|
||||
return false;
|
||||
}
|
||||
};
|
||||
|
||||
|
||||
var iteratorSupported = checkIfIteratorIsSupported();
|
||||
|
||||
var createIterator = function(items) {
|
||||
var iterator = {
|
||||
next: function() {
|
||||
var value = items.shift();
|
||||
return { done: value === void 0, value: value };
|
||||
}
|
||||
};
|
||||
|
||||
if(iteratorSupported) {
|
||||
iterator[Symbol.iterator] = function() {
|
||||
return iterator;
|
||||
};
|
||||
}
|
||||
|
||||
return iterator;
|
||||
};
|
||||
|
||||
/**
|
||||
* Search param name and values should be encoded according to https://url.spec.whatwg.org/#urlencoded-serializing
|
||||
* encodeURIComponent() produces the same result except encoding spaces as `%20` instead of `+`.
|
||||
*/
|
||||
var serializeParam = function(value) {
|
||||
return encodeURIComponent(value).replace(/%20/g, '+');
|
||||
};
|
||||
|
||||
var deserializeParam = function(value) {
|
||||
return decodeURIComponent(value).replace(/\+/g, ' ');
|
||||
};
|
||||
|
||||
var polyfillURLSearchParams= function() {
|
||||
|
||||
var URLSearchParams = function(searchString) {
|
||||
Object.defineProperty(this, '_entries', { value: {} });
|
||||
|
||||
if(typeof searchString === 'string') {
|
||||
if(searchString !== '') {
|
||||
searchString = searchString.replace(/^\?/, '');
|
||||
var attributes = searchString.split('&');
|
||||
var attribute;
|
||||
for(var i = 0; i < attributes.length; i++) {
|
||||
attribute = attributes[i].split('=');
|
||||
this.append(
|
||||
deserializeParam(attribute[0]),
|
||||
(attribute.length > 1) ? deserializeParam(attribute[1]) : ''
|
||||
);
|
||||
}
|
||||
}
|
||||
} else if(searchString instanceof URLSearchParams) {
|
||||
var _this = this;
|
||||
searchString.forEach(function(value, name) {
|
||||
_this.append(value, name);
|
||||
});
|
||||
}
|
||||
};
|
||||
|
||||
var proto = URLSearchParams.prototype;
|
||||
|
||||
proto.append = function(name, value) {
|
||||
if(name in this._entries) {
|
||||
this._entries[name].push(value.toString());
|
||||
} else {
|
||||
this._entries[name] = [value.toString()];
|
||||
}
|
||||
};
|
||||
|
||||
proto.delete = function(name) {
|
||||
delete this._entries[name];
|
||||
};
|
||||
|
||||
proto.get = function(name) {
|
||||
return (name in this._entries) ? this._entries[name][0] : null;
|
||||
};
|
||||
|
||||
proto.getAll = function(name) {
|
||||
return (name in this._entries) ? this._entries[name].slice(0) : [];
|
||||
};
|
||||
|
||||
proto.has = function(name) {
|
||||
return (name in this._entries);
|
||||
};
|
||||
|
||||
proto.set = function(name, value) {
|
||||
this._entries[name] = [value.toString()];
|
||||
};
|
||||
|
||||
proto.forEach = function(callback, thisArg) {
|
||||
var entries;
|
||||
for(var name in this._entries) {
|
||||
if(this._entries.hasOwnProperty(name)) {
|
||||
entries = this._entries[name];
|
||||
for(var i = 0; i < entries.length; i++) {
|
||||
callback.call(thisArg, entries[i], name, this);
|
||||
}
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
proto.keys = function() {
|
||||
var items = [];
|
||||
this.forEach(function(value, name) { items.push(name); });
|
||||
return createIterator(items);
|
||||
};
|
||||
|
||||
proto.values = function() {
|
||||
var items = [];
|
||||
this.forEach(function(value) { items.push(value); });
|
||||
return createIterator(items);
|
||||
};
|
||||
|
||||
proto.entries = function() {
|
||||
var items = [];
|
||||
this.forEach(function(value, name) { items.push([name, value]); });
|
||||
return createIterator(items);
|
||||
};
|
||||
|
||||
if(iteratorSupported) {
|
||||
proto[Symbol.iterator] = proto.entries;
|
||||
}
|
||||
|
||||
proto.toString = function() {
|
||||
var searchString = '';
|
||||
this.forEach(function(value, name) {
|
||||
if(searchString.length > 0) searchString+= '&';
|
||||
searchString += serializeParam(name) + '=' + serializeParam(value);
|
||||
});
|
||||
return searchString;
|
||||
};
|
||||
|
||||
global.URLSearchParams = URLSearchParams;
|
||||
};
|
||||
|
||||
if(!('URLSearchParams' in global) || (new URLSearchParams('?a=1').toString() !== 'a=1')) {
|
||||
polyfillURLSearchParams();
|
||||
}
|
||||
|
||||
// HTMLAnchorElement
|
||||
|
||||
})(
|
||||
(typeof global !== 'undefined') ? global
|
||||
: ((typeof window !== 'undefined') ? window
|
||||
: ((typeof self !== 'undefined') ? self : this))
|
||||
);
|
||||
|
||||
(function(global) {
|
||||
/**
|
||||
* Polyfill URL
|
||||
*
|
||||
* Inspired from : https://github.com/arv/DOM-URL-Polyfill/blob/master/src/url.js
|
||||
*/
|
||||
|
||||
var checkIfURLIsSupported = function() {
|
||||
try {
|
||||
var u = new URL('b', 'http://a');
|
||||
u.pathname = 'c%20d';
|
||||
return (u.href === 'http://a/c%20d') && u.searchParams;
|
||||
} catch(e) {
|
||||
return false;
|
||||
}
|
||||
};
|
||||
|
||||
|
||||
var polyfillURL = function() {
|
||||
var _URL = global.URL;
|
||||
|
||||
var URL = function(url, base) {
|
||||
if(typeof url !== 'string') url = String(url);
|
||||
|
||||
var doc = document.implementation.createHTMLDocument('');
|
||||
window.doc = doc;
|
||||
if(base) {
|
||||
var baseElement = doc.createElement('base');
|
||||
baseElement.href = base;
|
||||
doc.head.appendChild(baseElement);
|
||||
}
|
||||
|
||||
var anchorElement = doc.createElement('a');
|
||||
anchorElement.href = url;
|
||||
doc.body.appendChild(anchorElement);
|
||||
anchorElement.href = anchorElement.href; // force href to refresh
|
||||
|
||||
if(anchorElement.protocol === ':' || !/:/.test(anchorElement.href)) {
|
||||
throw new TypeError('Invalid URL');
|
||||
}
|
||||
|
||||
Object.defineProperty(this, '_anchorElement', {
|
||||
value: anchorElement
|
||||
});
|
||||
};
|
||||
|
||||
var proto = URL.prototype;
|
||||
|
||||
var linkURLWithAnchorAttribute = function(attributeName) {
|
||||
Object.defineProperty(proto, attributeName, {
|
||||
get: function() {
|
||||
return this._anchorElement[attributeName];
|
||||
},
|
||||
set: function(value) {
|
||||
this._anchorElement[attributeName] = value;
|
||||
},
|
||||
enumerable: true
|
||||
});
|
||||
};
|
||||
|
||||
['hash', 'host', 'hostname', 'port', 'protocol', 'search']
|
||||
.forEach(function(attributeName) {
|
||||
linkURLWithAnchorAttribute(attributeName);
|
||||
});
|
||||
|
||||
Object.defineProperties(proto, {
|
||||
|
||||
'toString': {
|
||||
get: function() {
|
||||
var _this = this;
|
||||
return function() {
|
||||
return _this.href;
|
||||
};
|
||||
}
|
||||
},
|
||||
|
||||
'href' : {
|
||||
get: function() {
|
||||
return this._anchorElement.href.replace(/\?$/,'');
|
||||
},
|
||||
set: function(value) {
|
||||
this._anchorElement.href = value;
|
||||
},
|
||||
enumerable: true
|
||||
},
|
||||
|
||||
'pathname' : {
|
||||
get: function() {
|
||||
return this._anchorElement.pathname.replace(/(^\/?)/,'/');
|
||||
},
|
||||
set: function(value) {
|
||||
this._anchorElement.pathname = value;
|
||||
},
|
||||
enumerable: true
|
||||
},
|
||||
|
||||
'origin': {
|
||||
get: function() {
|
||||
// get expected port from protocol
|
||||
var expectedPort = {'http:': 80, 'https:': 443, 'ftp:': 21}[this._anchorElement.protocol];
|
||||
// add port to origin if, expected port is different than actual port
|
||||
// and it is not empty f.e http://foo:8080
|
||||
// 8080 != 80 && 8080 != ''
|
||||
var addPortToOrigin = this._anchorElement.port != expectedPort &&
|
||||
this._anchorElement.port !== ''
|
||||
|
||||
return this._anchorElement.protocol +
|
||||
'//' +
|
||||
this._anchorElement.hostname +
|
||||
(addPortToOrigin ? (':' + this._anchorElement.port) : '');
|
||||
},
|
||||
enumerable: true
|
||||
},
|
||||
|
||||
'password': { // TODO
|
||||
get: function() {
|
||||
return '';
|
||||
},
|
||||
set: function(value) {
|
||||
},
|
||||
enumerable: true
|
||||
},
|
||||
|
||||
'username': { // TODO
|
||||
get: function() {
|
||||
return '';
|
||||
},
|
||||
set: function(value) {
|
||||
},
|
||||
enumerable: true
|
||||
},
|
||||
|
||||
'searchParams': {
|
||||
get: function() {
|
||||
var searchParams = new URLSearchParams(this.search);
|
||||
var _this = this;
|
||||
['append', 'delete', 'set'].forEach(function(methodName) {
|
||||
var method = searchParams[methodName];
|
||||
searchParams[methodName] = function() {
|
||||
method.apply(searchParams, arguments);
|
||||
_this.search = searchParams.toString();
|
||||
};
|
||||
});
|
||||
return searchParams;
|
||||
},
|
||||
enumerable: true
|
||||
}
|
||||
});
|
||||
|
||||
URL.createObjectURL = function(blob) {
|
||||
return _URL.createObjectURL.apply(_URL, arguments);
|
||||
};
|
||||
|
||||
URL.revokeObjectURL = function(url) {
|
||||
return _URL.revokeObjectURL.apply(_URL, arguments);
|
||||
};
|
||||
|
||||
global.URL = URL;
|
||||
|
||||
};
|
||||
|
||||
if(!checkIfURLIsSupported()) {
|
||||
polyfillURL();
|
||||
}
|
||||
|
||||
if((global.location !== void 0) && !('origin' in global.location)) {
|
||||
var getOrigin = function() {
|
||||
return global.location.protocol + '//' + global.location.hostname + (global.location.port ? (':' + global.location.port) : '');
|
||||
};
|
||||
|
||||
try {
|
||||
Object.defineProperty(global.location, 'origin', {
|
||||
get: getOrigin,
|
||||
enumerable: true
|
||||
});
|
||||
} catch(e) {
|
||||
setInterval(function() {
|
||||
global.location.origin = getOrigin();
|
||||
}, 100);
|
||||
}
|
||||
}
|
||||
|
||||
})(
|
||||
(typeof global !== 'undefined') ? global
|
||||
: ((typeof window !== 'undefined') ? window
|
||||
: ((typeof self !== 'undefined') ? self : this))
|
||||
);
|
||||
@ -4,6 +4,9 @@ import { I18n } from './services/i18n/i18n';
|
||||
import { UtilRegistry } from './services/util-registry/util-registry';
|
||||
import { isValidUtility } from './core/utility';
|
||||
|
||||
// load window.fetch polyfill
|
||||
import 'whatwg-fetch';
|
||||
|
||||
export class App {
|
||||
httpClient = new HttpClient();
|
||||
htmlHelpers = new HtmlHelpers();
|
||||
|
||||
@ -24,7 +24,7 @@ export class HtmlHelpers {
|
||||
}
|
||||
|
||||
_prefixIds(element, idPrefix) {
|
||||
const idAttrs = ['id', 'for', 'data-conditional-input', 'data-modal-trigger'];
|
||||
const idAttrs = ['id', 'for', 'list', 'data-conditional-input', 'data-modal-trigger'];
|
||||
|
||||
idAttrs.forEach((attr) => {
|
||||
Array.from(element.querySelectorAll('[' + attr + ']')).forEach((input) => {
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
const DEBUG_MODE = /localhost/.test(window.location.href) && 0;
|
||||
const DEBUG_MODE = /localhost/.test(window.location.href) ? 2 : 0;
|
||||
|
||||
export class UtilRegistry {
|
||||
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
import { Utility } from '../../core/utility';
|
||||
import { Datepicker } from '../form/datepicker';
|
||||
import './async-form.scss';
|
||||
|
||||
const ASYNC_FORM_INITIALIZED_CLASS = 'check-all--initialized';
|
||||
@ -70,7 +71,9 @@ export class AsyncForm {
|
||||
|
||||
const url = this._element.getAttribute('action');
|
||||
const headers = { };
|
||||
const body = new FormData(this._element);
|
||||
|
||||
// create new FormData and format any date values
|
||||
const body = Datepicker.unformatAll(this._element, new FormData(this._element));
|
||||
|
||||
const isModal = this._element.closest(MODAL_SELECTOR);
|
||||
if (isModal) {
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
import { Utility } from '../../core/utility';
|
||||
import { Datepicker } from '../form/datepicker';
|
||||
import { HttpClient } from '../../services/http-client/http-client';
|
||||
import * as debounce from 'lodash.debounce';
|
||||
import './async-table-filter.scss';
|
||||
@ -238,6 +239,10 @@ export class AsyncTable {
|
||||
|
||||
_serializeTableFilterToURL(tableFilterForm) {
|
||||
const url = new URL(getLocalStorageParameter('currentTableUrl') || window.location.href);
|
||||
|
||||
// format any date values before submission
|
||||
Datepicker.destroyAllFormInputDates(tableFilterForm);
|
||||
|
||||
const formData = new FormData(tableFilterForm);
|
||||
|
||||
for (var k of url.searchParams.keys()) {
|
||||
@ -298,7 +303,9 @@ export class AsyncTable {
|
||||
|
||||
_changePagesizeHandler = () => {
|
||||
const url = new URL(getLocalStorageParameter('currentTableUrl') || window.location.href);
|
||||
const formData = new FormData(this._pagesizeForm);
|
||||
|
||||
// create new FormData and format any date values
|
||||
const formData = Datepicker.unformatAll(this._pagesizeForm, new FormData(this._pagesizeForm));
|
||||
|
||||
for (var k of url.searchParams.keys()) {
|
||||
url.searchParams.delete(k);
|
||||
|
||||
@ -1,30 +1,90 @@
|
||||
import flatpickr from 'flatpickr';
|
||||
import datetime from 'tail.datetime';
|
||||
import { Utility } from '../../core/utility';
|
||||
import moment from 'moment';
|
||||
|
||||
const KEYCODE_ESCAPE = 27;
|
||||
|
||||
// INTERNAL (Uni2work specific) formats for formatting dates and/or times
|
||||
const FORM_DATE_FORMAT = {
|
||||
'date': moment.HTML5_FMT.DATE,
|
||||
'time': moment.HTML5_FMT.TIME_SECONDS,
|
||||
'datetime-local': moment.HTML5_FMT.DATETIME_LOCAL_SECONDS,
|
||||
};
|
||||
|
||||
// FANCY (tail.datetime specific) formats for displaying dates and/or times
|
||||
const FORM_DATE_FORMAT_DATE_DT = 'dd.mm.YYYY';
|
||||
const FORM_DATE_FORMAT_TIME_DT = 'HH:ii:ss';
|
||||
|
||||
// FANCY (moment specific) formats for displaying dates and/or times
|
||||
const FORM_DATE_FORMAT_DATE_MOMENT = 'DD.MM.YYYY';
|
||||
const FORM_DATE_FORMAT_TIME_MOMENT = 'HH:mm:ss';
|
||||
const FORM_DATE_FORMAT_MOMENT = {
|
||||
'date': FORM_DATE_FORMAT_DATE_MOMENT,
|
||||
'time': FORM_DATE_FORMAT_TIME_MOMENT,
|
||||
'datetime-local': `${FORM_DATE_FORMAT_DATE_MOMENT} ${FORM_DATE_FORMAT_TIME_MOMENT}`,
|
||||
};
|
||||
|
||||
/**
|
||||
* Takes a string representation of a date and a format string and parses the given date to a Date object.
|
||||
* If the date string is not valid (i.e. cannot be parsed with the given format string), returns undefined.
|
||||
* @param {*} dateStr string representation of a date
|
||||
* @param {*} dateFormat format string of the date
|
||||
*/
|
||||
function parseDateWithFormat(dateStr, dateFormat) {
|
||||
const parsedMomentDate = moment(dateStr, dateFormat);
|
||||
if (parsedMomentDate.isValid()) return parsedMomentDate.toDate();
|
||||
}
|
||||
|
||||
/**
|
||||
* Takes a string representation of a date, an input ('previous') format and a desired output format and returns a reformatted date string.
|
||||
* If the date string is not valid (i.e. cannot be parsed with the given input format string), returns the original date string;
|
||||
* @param {*} dateStr string representation of a date (needs to be in format formatIn)
|
||||
* @param {*} formatIn input format string
|
||||
* @param {*} formatOut format string of the desired output date string
|
||||
*/
|
||||
function reformatDateString(dateStr, formatIn, formatOut) {
|
||||
const parsedMomentDate = moment(dateStr, formatIn);
|
||||
return parsedMomentDate.isValid() ? parsedMomentDate.format(formatOut) : dateStr;
|
||||
}
|
||||
|
||||
const DATEPICKER_UTIL_SELECTOR = 'input[type="date"], input[type="time"], input[type="datetime-local"]';
|
||||
|
||||
const DATEPICKER_INITIALIZED_CLASS = 'datepicker--initialized';
|
||||
|
||||
const DATEPICKER_CONFIG = {
|
||||
'datetime-local': {
|
||||
enableTime: true,
|
||||
altInput: true,
|
||||
altFormat: 'j. F Y, H:i', // maybe interpolate these formats for locale
|
||||
dateFormat: 'Y-m-dTH:i',
|
||||
time_24hr: true,
|
||||
'global': {
|
||||
// minimize overlaps with other date inputs
|
||||
position: 'right',
|
||||
|
||||
// set default time to 00:00:00
|
||||
timeHours: 0,
|
||||
timeMinutes: 0,
|
||||
timeSeconds: 0,
|
||||
|
||||
// german settings
|
||||
// TODO: hardcoded, get from current language / settings
|
||||
locale: 'de',
|
||||
weekStart: 1,
|
||||
dateFormat: FORM_DATE_FORMAT_DATE_DT,
|
||||
timeFormat: FORM_DATE_FORMAT_TIME_DT,
|
||||
|
||||
// prevent the instance from closing when selecting a date before selecting a time
|
||||
stayOpen: true,
|
||||
|
||||
// hide the close button (we handle closing the datepicker manually by clicking outside)
|
||||
closeButton: false,
|
||||
|
||||
// disable the decades view because nobody will ever need it (i.e. cap the switch to the more relevant year view)
|
||||
viewDecades: false,
|
||||
},
|
||||
'datetime-local': {},
|
||||
'date': {
|
||||
altFormat: 'j. F Y',
|
||||
dateFormat: 'Y-m-d',
|
||||
altInput: true,
|
||||
// disable date picker
|
||||
timeFormat: false,
|
||||
},
|
||||
'time': {
|
||||
enableTime: true,
|
||||
noCalendar: true,
|
||||
altFormat: 'H:i',
|
||||
dateFormat: 'H:i',
|
||||
altInput: true,
|
||||
time_24hr: true,
|
||||
// disable time picker
|
||||
dateFormat: false,
|
||||
},
|
||||
};
|
||||
|
||||
@ -33,7 +93,12 @@ const DATEPICKER_CONFIG = {
|
||||
})
|
||||
export class Datepicker {
|
||||
|
||||
flatpickrInstance;
|
||||
// singleton Map that maps a formID to a Map of Datepicker objects
|
||||
static datepickerCollections;
|
||||
|
||||
datepickerInstance;
|
||||
_element;
|
||||
elementType;
|
||||
|
||||
constructor(element) {
|
||||
if (!element) {
|
||||
@ -44,19 +109,140 @@ export class Datepicker {
|
||||
return false;
|
||||
}
|
||||
|
||||
const flatpickrConfig = DATEPICKER_CONFIG[element.getAttribute('type')];
|
||||
// initialize datepickerCollections singleton if not already done
|
||||
if (!Datepicker.datepickerCollections) {
|
||||
Datepicker.datepickerCollections = new Map();
|
||||
}
|
||||
|
||||
if (!flatpickrConfig) {
|
||||
this._element = element;
|
||||
|
||||
// store the previously set type to select the input format
|
||||
this.elementType = this._element.getAttribute('type');
|
||||
|
||||
// get all relevant config options for this datepicker type
|
||||
const datepickerGlobalConfig = DATEPICKER_CONFIG['global'];
|
||||
const datepickerConfig = DATEPICKER_CONFIG[this.elementType];
|
||||
|
||||
// manually set the type attribute to text because datepicker handles displaying the date
|
||||
this._element.setAttribute('type', 'text');
|
||||
|
||||
// additional position config (optional data-datepicker-position attribute in html) that can specialize the global config
|
||||
const datepickerPosition = this._element.dataset.datepickerPosition;
|
||||
if (datepickerPosition) {
|
||||
datepickerGlobalConfig.position = datepickerPosition;
|
||||
}
|
||||
|
||||
if (!datepickerConfig || !FORM_DATE_FORMAT[this.elementType]) {
|
||||
throw new Error('Datepicker utility called on unsupported element!');
|
||||
}
|
||||
|
||||
this.flatpickrInstance = flatpickr(element, flatpickrConfig);
|
||||
// initialize tail.datetime (datepicker) instance
|
||||
this.datepickerInstance = datetime(this._element, { ...datepickerGlobalConfig, ...datepickerConfig });
|
||||
|
||||
// mark initialized
|
||||
element.classList.add(DATEPICKER_INITIALIZED_CLASS);
|
||||
// register this datepicker instance with the formID of the given element in the datepicker collection
|
||||
const formID = this._element.form.id;
|
||||
const elemID = this._element.id;
|
||||
if (!Datepicker.datepickerCollections.has(formID)) {
|
||||
// insert a new key value pair if the formID key is not there already
|
||||
Datepicker.datepickerCollections.set(formID, new Map([[elemID, this]]));
|
||||
} else {
|
||||
// otherwise, insert this instance into the Map
|
||||
Datepicker.datepickerCollections.get(formID).set(elemID, this);
|
||||
}
|
||||
|
||||
// mark the form input element as initialized
|
||||
this._element.classList.add(DATEPICKER_INITIALIZED_CLASS);
|
||||
|
||||
const setDatepickerDate = () => {
|
||||
// try to parse the current input element value with fancy and internal format string
|
||||
const parsedMomentDate = moment(this._element.value, FORM_DATE_FORMAT_MOMENT[this.elementType]);
|
||||
const parsedMomentDateInternal = moment(this._element.value, FORM_DATE_FORMAT[this.elementType]);
|
||||
|
||||
// only set the datepicker date if the input is either in valid fancy format or in valid internal format
|
||||
if (parsedMomentDate.isValid()) {
|
||||
this.datepickerInstance.selectDate(parsedMomentDate.toDate());
|
||||
} else if (parsedMomentDateInternal.isValid()) {
|
||||
this.datepickerInstance.selectDate(parsedMomentDateInternal.toDate());
|
||||
}
|
||||
|
||||
// reregister change event to prevent event loop
|
||||
this._element.addEventListener('change', setDatepickerDate, { once: true });
|
||||
};
|
||||
// change the selected date in the tail.datetime instance if the value of the input element is changed
|
||||
this._element.addEventListener('change', setDatepickerDate, { once: true });
|
||||
|
||||
// close the instance if something other than the instance was clicked (i.e. if the target is not within the datepicker instance and if any previously clicked calendar view was replaced (is not in the window anymore) because it was clicked). YES, I KNOW
|
||||
window.addEventListener('click', event => {
|
||||
if (!this.datepickerInstance.dt.contains(event.target) && window.document.contains(event.target)) {
|
||||
this.datepickerInstance.close();
|
||||
}
|
||||
});
|
||||
|
||||
// close the datepicker on escape keydown events
|
||||
this._element.addEventListener('keydown', event => {
|
||||
if (event.keyCode === KEYCODE_ESCAPE) {
|
||||
this.datepickerInstance.close();
|
||||
}
|
||||
});
|
||||
|
||||
// format the date value of the form input element of this datepicker before form submission
|
||||
this._element.form.addEventListener('submit', () => this.formatElementValue());
|
||||
|
||||
// format any existing dates to fancy display format on pageload
|
||||
this.formatElementValue(true);
|
||||
}
|
||||
|
||||
destroy() {
|
||||
this.flatpickrInstance.destroy();
|
||||
this.datepickerInstance.remove();
|
||||
}
|
||||
}
|
||||
|
||||
/**
|
||||
* Formats the value of this input element from datepicker format (i.e. DATEPICKER_CONFIG.dateFormat + " " + datetime.defaults.timeFormat) to Uni2work internal date format (i.e. FORM_DATE_FORMAT) required for form submission
|
||||
* @param {*} toFancy optional target format switch (boolean value; default is false). If set to a truthy value, formats the element value to fancy instead of internal date format.
|
||||
*/
|
||||
formatElementValue(toFancy) {
|
||||
const dp = this.datepickerInstance;
|
||||
if (this._element.value) {
|
||||
if (toFancy) {
|
||||
const parsedDate = parseDateWithFormat(this._element.value, FORM_DATE_FORMAT[this.elementType]);
|
||||
if (parsedDate) dp.selectDate();
|
||||
} else {
|
||||
this._element.value = this.unformat();
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/**
|
||||
* Returns a datestring in internal format from the current state of the input element value.
|
||||
*/
|
||||
unformat() {
|
||||
return reformatDateString(this._element.value, FORM_DATE_FORMAT_MOMENT[this.elementType], FORM_DATE_FORMAT[this.elementType]);
|
||||
}
|
||||
|
||||
/**
|
||||
* Takes a Form and a FormData and returns a new FormData with all dates formatted to uni2work date format. This function will not change the value of the date input elements.
|
||||
* @param {*} form Form for which all dates will be formatted in the FormData
|
||||
* @param {*} formData Initial FormData
|
||||
*/
|
||||
static unformatAll(form, formData) {
|
||||
// only proceed if there are any datepickers and if both form and formData are defined
|
||||
if (Datepicker.datepickerCollections && form && formData) {
|
||||
// if the form has no id, assign one randomly
|
||||
if (!form.id) {
|
||||
form.id = `f${Math.floor(Math.random() * 100000)}`;
|
||||
}
|
||||
|
||||
const formId = form.id;
|
||||
|
||||
if (Datepicker.datepickerCollections.has(formId)) {
|
||||
const datepickerInstances = Datepicker.datepickerCollections.get(formId);
|
||||
datepickerInstances.forEach(instance => {
|
||||
formData.set(instance._element.name, instance.unformat());
|
||||
});
|
||||
}
|
||||
}
|
||||
|
||||
// return the (possibly changed) FormData
|
||||
return formData;
|
||||
}
|
||||
}
|
||||
@ -6,3 +6,9 @@ Provides UI for entering dates and times
|
||||
|
||||
## Example usage:
|
||||
(any form that uses inputs of type date, time, or datetime-local)
|
||||
|
||||
## Methods
|
||||
|
||||
### static unformatAll(form, formData)
|
||||
|
||||
Call this function on a form and its formData to get back a new FormData object with "unformatted" date values (i.e. all dates formatted from fancy format to backend format).
|
||||
@ -16,6 +16,7 @@ export class InteractiveFieldset {
|
||||
conditionalValue;
|
||||
target;
|
||||
childInputs;
|
||||
negated;
|
||||
|
||||
constructor(element) {
|
||||
if (!element) {
|
||||
@ -43,11 +44,13 @@ export class InteractiveFieldset {
|
||||
}
|
||||
|
||||
// param conditionalValue
|
||||
if (!this._element.dataset.conditionalValue && !this._isCheckbox()) {
|
||||
if (!('conditionalValue' in this._element.dataset) && !this._isCheckbox()) {
|
||||
throw new Error('Interactive Fieldset needs a conditional value!');
|
||||
}
|
||||
this.conditionalValue = this._element.dataset.conditionalValue;
|
||||
|
||||
this.negated = 'conditionalNegated' in this._element.dataset;
|
||||
|
||||
this.target = this._element.closest(INTERACTIVE_FIELDSET_UTIL_TARGET_SELECTOR);
|
||||
if (!this.target || this._element.matches(INTERACTIVE_FIELDSET_UTIL_TARGET_SELECTOR)) {
|
||||
this.target = this._element;
|
||||
@ -88,11 +91,19 @@ export class InteractiveFieldset {
|
||||
}
|
||||
|
||||
_matchesConditionalValue() {
|
||||
var matches;
|
||||
|
||||
if (this._isCheckbox()) {
|
||||
return this.conditionalInput.checked === true;
|
||||
matches = this.conditionalInput.checked === true;
|
||||
} else {
|
||||
matches = this.conditionalInput.value === this.conditionalValue;
|
||||
}
|
||||
|
||||
return this.conditionalInput.value === this.conditionalValue;
|
||||
if (this.negated) {
|
||||
return !matches;
|
||||
} else {
|
||||
return matches;
|
||||
}
|
||||
}
|
||||
|
||||
_isCheckbox() {
|
||||
|
||||
@ -8,6 +8,8 @@ Shows/hides inputs based on value of particular input
|
||||
Selector for the input that this fieldset watches for changes
|
||||
- `data-conditional-value: string`\
|
||||
The value the conditional input needs to be set to for this fieldset to be shown. Can be omitted if conditionalInput is a checkbox
|
||||
- `data-conditional-negated`\
|
||||
If present, negates the match on `data-conditional-value`
|
||||
|
||||
## Example usage:
|
||||
### example with text input
|
||||
|
||||
@ -2,6 +2,16 @@ import { Utility } from '../../core/utility';
|
||||
import { AUTO_SUBMIT_BUTTON_UTIL_SELECTOR } from './auto-submit-button';
|
||||
import { AUTO_SUBMIT_INPUT_UTIL_SELECTOR } from './auto-submit-input';
|
||||
|
||||
/**
|
||||
* Key generator from an arbitrary number of FormData objects.
|
||||
* @param {...any} formDatas FormData objects
|
||||
*/
|
||||
function* generatorFromFormDatas(...formDatas) {
|
||||
for (let formData of formDatas) {
|
||||
yield* formData.keys();
|
||||
}
|
||||
}
|
||||
|
||||
const NAVIGATE_AWAY_PROMPT_INITIALIZED_CLASS = 'navigate-away-prompt--initialized';
|
||||
const NAVIGATE_AWAY_PROMPT_UTIL_OPTOUT = '[uw-no-navigate-away-prompt]';
|
||||
|
||||
@ -12,7 +22,7 @@ export class NavigateAwayPrompt {
|
||||
|
||||
_element;
|
||||
|
||||
_touched = false;
|
||||
_initFormData;
|
||||
_unloadDueToSubmit = false;
|
||||
|
||||
constructor(element) {
|
||||
@ -21,6 +31,7 @@ export class NavigateAwayPrompt {
|
||||
}
|
||||
|
||||
this._element = element;
|
||||
this._initFormData = new FormData(this._element);
|
||||
|
||||
if (this._element.classList.contains(NAVIGATE_AWAY_PROMPT_INITIALIZED_CLASS)) {
|
||||
return false;
|
||||
@ -40,10 +51,6 @@ export class NavigateAwayPrompt {
|
||||
this._element.addEventListener('submit', () => {
|
||||
this._unloadDueToSubmit = true;
|
||||
});
|
||||
this._element.addEventListener('change', () => {
|
||||
this._touched = true;
|
||||
this._unloadDueToSubmit = false;
|
||||
});
|
||||
|
||||
// mark initialized
|
||||
this._element.classList.add(NAVIGATE_AWAY_PROMPT_INITIALIZED_CLASS);
|
||||
@ -55,9 +62,20 @@ export class NavigateAwayPrompt {
|
||||
}
|
||||
|
||||
_beforeUnloadHandler = (event) => {
|
||||
// compare every value of the current FormData with every corresponding value of the initial FormData and set formDataHasChanged to true if there is at least one change
|
||||
const currentFormData = new FormData(this._element);
|
||||
var formDataHasChanged = false;
|
||||
for (let key of generatorFromFormDatas(this._initFormData, currentFormData)) {
|
||||
if (currentFormData.get(key) !== this._initFormData.get(key)) {
|
||||
formDataHasChanged = true;
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
// allow the event to happen if the form was not touched by the
|
||||
// user or the unload event was initiated by a form submit
|
||||
if (!this._touched || this._unloadDueToSubmit) {
|
||||
// user (i.e. if the current FormData is equal to the initial FormData)
|
||||
// or the unload event was initiated by a form submit
|
||||
if (!formDataHasChanged || this._unloadDueToSubmit) {
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
@ -1,6 +1,15 @@
|
||||
/* GENERAL STYLES FOR FORMS */
|
||||
|
||||
/* FORM GROUPS */
|
||||
.form-section-title {
|
||||
color: var(--color-fontsec);
|
||||
margin: 0;
|
||||
|
||||
+ .form-group {
|
||||
margin-top: 11px;
|
||||
}
|
||||
}
|
||||
|
||||
.form-group {
|
||||
position: relative;
|
||||
display: flex;
|
||||
@ -9,11 +18,9 @@
|
||||
grid-gap: 5px;
|
||||
justify-content: flex-start;
|
||||
align-items: flex-start;
|
||||
padding: 4px 0;
|
||||
border-left: 2px solid transparent;
|
||||
|
||||
+ .form-group {
|
||||
margin-top: 7px;
|
||||
+ .form-group, + .form-section-legend, + .form-section-notification {
|
||||
margin-top: 11px;
|
||||
}
|
||||
|
||||
+ .form-section-title {
|
||||
@ -21,15 +28,22 @@
|
||||
}
|
||||
}
|
||||
|
||||
.form-section-title {
|
||||
color: var(--color-fontsec);
|
||||
}
|
||||
|
||||
.form-section-legend {
|
||||
color: var(--color-fontsec);
|
||||
margin: 7px 0;
|
||||
}
|
||||
|
||||
.form-section-title__hint {
|
||||
margin-top: 7px;
|
||||
color: var(--color-fontsec);
|
||||
font-size: 0.9rem;
|
||||
font-weight: 600;
|
||||
|
||||
+ .form-group {
|
||||
margin-top: 11px;
|
||||
}
|
||||
}
|
||||
|
||||
.form-group-label {
|
||||
font-weight: 600;
|
||||
padding-top: 6px;
|
||||
|
||||
@ -1,4 +1,6 @@
|
||||
import { Utility } from '../../core/utility';
|
||||
import { Datepicker } from '../form/datepicker';
|
||||
import './mass-input.scss';
|
||||
|
||||
const MASS_INPUT_CELL_SELECTOR = '.massinput__cell';
|
||||
const MASS_INPUT_ADD_CELL_SELECTOR = '.massinput__cell--add';
|
||||
@ -157,7 +159,8 @@ export class MassInput {
|
||||
}
|
||||
|
||||
_serializeForm(submitButton, enctype) {
|
||||
const formData = new FormData(this._massInputForm);
|
||||
// create new FormData and format any date values
|
||||
const formData = Datepicker.unformatAll(this._massInputForm, new FormData(this._massInputForm));
|
||||
|
||||
// manually add name and value of submit button to formData
|
||||
formData.append(submitButton.name, submitButton.value);
|
||||
|
||||
18
frontend/src/utils/mass-input/mass-input.scss
Normal file
18
frontend/src/utils/mass-input/mass-input.scss
Normal file
@ -0,0 +1,18 @@
|
||||
.massinput-list__wrapper, .massinput-list__cell {
|
||||
display: grid;
|
||||
grid: auto / auto 50px;
|
||||
max-width: 600px;
|
||||
grid-gap: 7px;
|
||||
}
|
||||
|
||||
.massinput-list__field {
|
||||
grid-column: 1;
|
||||
}
|
||||
|
||||
.massinput-list__add, .massinput-list__delete {
|
||||
grid-column: 2;
|
||||
}
|
||||
|
||||
.massinput-list__cell {
|
||||
grid-column: 1 / 3;
|
||||
}
|
||||
727
frontend/vendor/datetime.css
vendored
Normal file
727
frontend/vendor/datetime.css
vendored
Normal file
@ -0,0 +1,727 @@
|
||||
@charset "UTF-8";
|
||||
/*
|
||||
| tail.datetime - The vanilla way to select dates and times!
|
||||
| @file ./less/tail.datetime-default-green.less
|
||||
| @author SamBrishes <sam@pytes.net>
|
||||
| @version 0.4.13 - Beta
|
||||
|
|
||||
| @website https://github.com/pytesNET/tail.DateTime
|
||||
| @license X11 / MIT License
|
||||
| @copyright Copyright © 2018 - 2019 SamBrishes, pytesNET <info@pytes.net>
|
||||
*/
|
||||
|
||||
/* @start MAIN CALENDAR */
|
||||
.tail-datetime-calendar, .tail-datetime-calendar *, .tail-datetime-calendar *:before,
|
||||
.tail-datetime-calendar *:after{
|
||||
box-sizing: border-box;
|
||||
-webkit-box-sizing: border-box;
|
||||
}
|
||||
.tail-datetime-calendar{
|
||||
top: 0;
|
||||
left: 0;
|
||||
width: 275px;
|
||||
height: auto;
|
||||
margin: 15px;
|
||||
padding: 0;
|
||||
z-index: 15;
|
||||
display: block;
|
||||
position: absolute;
|
||||
visibility: hidden;
|
||||
direction: ltr;
|
||||
border-collapse: separate;
|
||||
font-family: "Open Sans", Calibri, Arial, sans-serif;
|
||||
background-color: white;
|
||||
border-width: 0;
|
||||
border-style: solid;
|
||||
border-color: transparent;
|
||||
border-radius: 3px;
|
||||
box-shadow: 0 1px 3px rgba(0, 0, 0, 0.3125);
|
||||
-webkit-box-shadow: 0 1px 3px rgba(0, 0, 0, 0.3125);
|
||||
}
|
||||
.tail-datetime-calendar:after{
|
||||
clear: both;
|
||||
content: "";
|
||||
display: block;
|
||||
font-size: 0;
|
||||
visibility: hidden;
|
||||
}
|
||||
.tail-datetime-calendar.calendar-static{
|
||||
top: auto;
|
||||
left: auto;
|
||||
margin-left: auto;
|
||||
margin-right: auto;
|
||||
position: static;
|
||||
visibility: visible;
|
||||
}
|
||||
.tail-datetime-calendar button.calendar-close{
|
||||
top: 100%;
|
||||
right: 15px;
|
||||
color: #303438;
|
||||
width: 35px;
|
||||
height: 25px;
|
||||
margin: 1px 0 0 0;
|
||||
padding: 5px 10px;
|
||||
opacity: 0.5;
|
||||
outline: none;
|
||||
display: inline-block;
|
||||
position: absolute;
|
||||
font-size: 14px;
|
||||
line-height: 1.125em;
|
||||
text-shadow: none;
|
||||
background-color: white;
|
||||
background-image: url("data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC\
|
||||
9zdmciIHdpZHRoPSIxMiIgaGVpZ2h0PSIxNiIgdmlld0JveD0iMCAwIDEyIDE2Ij48cGF0aCBmaWxsPSIjMzAzNDM4IiBkP\
|
||||
SJNNy40OCA4bDMuNzUgMy43NS0xLjQ4IDEuNDhMNiA5LjQ4bC0zLjc1IDMuNzUtMS40OC0xLjQ4TDQuNTIgOCAuNzcgNC4y\
|
||||
NWwxLjQ4LTEuNDhMNiA2LjUybDMuNzUtMy43NSAxLjQ4IDEuNDhMNy40OCA4eiIvPjwvc3ZnPg==");
|
||||
background-repeat: no-repeat;
|
||||
background-position: center center;
|
||||
border-width: 0;
|
||||
border-style: solid;
|
||||
border-color: transparent;
|
||||
border-radius: 0 0 3px 3px;
|
||||
box-shadow: 0 1px 3px rgba(0, 0, 0, 0.3125);
|
||||
-webkit-box-shadow: 0 1px 3px rgba(0, 0, 0, 0.3125);
|
||||
transition: opacity 142ms linear;
|
||||
-webkit-transition: opacity 142ms linear;
|
||||
}
|
||||
.tail-datetime-calendar button.calendar-close:hover{
|
||||
opacity: 1;
|
||||
}
|
||||
/* @end MAIN CALENDAR */
|
||||
|
||||
/* @start CALENDAR TOOLTIP */
|
||||
.tail-datetime-calendar .calendar-tooltip{
|
||||
color: white;
|
||||
width: auto;
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
display: block;
|
||||
position: absolute;
|
||||
background-color: #202428;
|
||||
border-radius: 3px;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-tooltip:before{
|
||||
top: -7px;
|
||||
left: 50%;
|
||||
width: 0;
|
||||
height: 0;
|
||||
margin: 0 0 0 -6px;
|
||||
content: "";
|
||||
display: block;
|
||||
position: absolute;
|
||||
border-width: 0 7px 7px 7px;
|
||||
border-style: solid;
|
||||
border-color: transparent transparent #202428 transparent;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-tooltip .tooltip-inner{
|
||||
width: auto;
|
||||
margin: 0;
|
||||
padding: 4px 7px;
|
||||
display: block;
|
||||
font-size: 12px;
|
||||
line-height: 14px;
|
||||
}
|
||||
/* @end CALENDAR TOOLTIP */
|
||||
|
||||
/* @start CALENDAR ACTIONs */
|
||||
.tail-datetime-calendar .calendar-actions{
|
||||
color: white;
|
||||
width: 100%;
|
||||
height: 36px;
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
display: table;
|
||||
overflow: hidden;
|
||||
border-spacing: 0;
|
||||
border-collapse: separate;
|
||||
background-color: var(--color-primary);
|
||||
border-width: 0;
|
||||
border-style: solid;
|
||||
border-color: transparent;
|
||||
border-radius: 3px 3px 0 0;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-actions span{
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
display: table-cell;
|
||||
position: relative;
|
||||
text-align: center;
|
||||
line-height: 36px;
|
||||
text-shadow: -1px -1px 0 var(--color-dark);
|
||||
background-repeat: no-repeat;
|
||||
background-position: center center;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-actions span[data-action]{
|
||||
cursor: pointer;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-actions span.action{
|
||||
width: 36px;
|
||||
font-size: 22px;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-actions span.label{
|
||||
width: auto;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-actions span:first-child:before{
|
||||
right: -1px;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-actions span:last-child:before{
|
||||
left: -1px;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-actions span:first-child:hover:before,
|
||||
.tail-datetime-calendar .calendar-actions span:last-child:hover:before{
|
||||
display: none;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-actions span[data-action]:hover{
|
||||
background-color: var(--color-dark);
|
||||
}
|
||||
.tail-datetime-calendar .calendar-actions span.action-prev{
|
||||
background-image: url("data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC\
|
||||
9zdmciIHdpZHRoPSI2IiBoZWlnaHQ9IjE2IiB2aWV3Qm94PSIwIDAgNiAxNiI+PHBhdGggZmlsbD0iI2ZmZmZmZiIgZD0iT\
|
||||
TYgMkwwIDhsNiA2VjJ6Ii8+PC9zdmc+");
|
||||
}
|
||||
.tail-datetime-calendar .calendar-actions span.action-next{
|
||||
background-image: url("data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC\
|
||||
9zdmciIHdpZHRoPSI2IiBoZWlnaHQ9IjE2IiB2aWV3Qm94PSIwIDAgNiAxNiI+PHBhdGggZmlsbD0iI2ZmZmZmZiIgZD0iT\
|
||||
TAgMTRsNi02LTYtNnYxMnoiLz48L3N2Zz4=");
|
||||
}
|
||||
.tail-datetime-calendar .calendar-actions span.action-submit{
|
||||
background-image: url("data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC\
|
||||
9zdmciIHdpZHRoPSIxMiIgaGVpZ2h0PSIxNiIgdmlld0JveD0iMCAwIDEyIDE2Ij48cGF0aCBmaWxsPSIjZmZmZmZmIiBkP\
|
||||
SJNMTIgNWwtOCA4LTQtNCAxLjUtMS41TDQgMTBsNi41LTYuNUwxMiA1eiIvPjwvc3ZnPg==");
|
||||
}
|
||||
.tail-datetime-calendar .calendar-actions span.action-cancel{
|
||||
background-image: url("data:image/svg+xml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC\
|
||||
9zdmciIHdpZHRoPSIxMiIgaGVpZ2h0PSIxNiIgdmlld0JveD0iMCAwIDEyIDE2Ij48cGF0aCBmaWxsPSIjZmZmZmZmIiBkP\
|
||||
SJNNy40OCA4bDMuNzUgMy43NS0xLjQ4IDEuNDhMNiA5LjQ4bC0zLjc1IDMuNzUtMS40OC0xLjQ4TDQuNTIgOCAuNzcgNC4y\
|
||||
NWwxLjQ4LTEuNDhMNiA2LjUybDMuNzUtMy43NSAxLjQ4IDEuNDhMNy40OCA4eiIvPjwvc3ZnPg==");
|
||||
}
|
||||
/* @end CALENDAR ACTIONs */
|
||||
|
||||
/* @start CALENDAR DATEPICKER */
|
||||
.tail-datetime-calendar .calendar-datepicker{
|
||||
width: 100%;
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
display: block;
|
||||
position: relative;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table{
|
||||
width: 100%;
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
border-spacing: 0;
|
||||
border-collapse: separate;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr th,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td{
|
||||
color: #303438;
|
||||
height: 30px;
|
||||
padding: 0;
|
||||
position: relative;
|
||||
font-size: 13px;
|
||||
text-align: center;
|
||||
font-weight: normal;
|
||||
text-shadow: none;
|
||||
line-height: 30px;
|
||||
background-color: transparent;
|
||||
border-width: 0;
|
||||
border-style: solid;
|
||||
border-color: transparent;
|
||||
border-radius: 0px;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr th{
|
||||
color: white;
|
||||
background-color: var(--color-lightblack);
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td{
|
||||
cursor: pointer;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td span.inner{
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
display: inline-block;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.date-disabled{
|
||||
cursor: not-allowed;
|
||||
color: #909498;
|
||||
background-color: #F0F0F0;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.date-disabled:after{
|
||||
left: 3px;
|
||||
bottom: 3px;
|
||||
width: 35px;
|
||||
height: 1px;
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
content: "";
|
||||
display: inline-block;
|
||||
position: absolute;
|
||||
background-color: #bfbfbf;
|
||||
transform-origin: 2px -5px;
|
||||
transform: rotate(-45deg);
|
||||
-moz-transform: rotate(-45deg);
|
||||
-webkit-transform: rotate(-45deg);
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.date-previous,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.date-next{
|
||||
color: #909498;
|
||||
background-color: #F0F0F0;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.date-today:before,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td .tooltip-tick{
|
||||
top: 5px;
|
||||
width: 5px;
|
||||
height: 5px;
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
z-index: 20;
|
||||
content: "";
|
||||
display: inline-block;
|
||||
position: absolute;
|
||||
border-width: 0;
|
||||
border-style: solid;
|
||||
border-color: transparent;
|
||||
border-radius: 50%;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.date-today:before{
|
||||
left: 5px;
|
||||
background-color: #E67D1E;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td .tooltip-tick{
|
||||
right: 5px;
|
||||
background-color: #202428;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td .tooltip-tick:before,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td .tooltip-tick:after{
|
||||
display: none;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr th.calendar-week,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-day{
|
||||
width: 14.28571429%;
|
||||
height: 35px;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr th.calendar-week span.inner,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-day span.inner{
|
||||
width: 31px;
|
||||
height: 31px;
|
||||
line-height: 29px;
|
||||
border-width: 1px;
|
||||
border-style: solid;
|
||||
border-color: transparent;
|
||||
border-radius: 50%;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr th.calendar-week:hover span.inner,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-day:hover span.inner{
|
||||
border-color: #cccccc;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr th.calendar-week.date-disabled span.inner,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-day.date-disabled span.inner,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr th.calendar-week.date-disabled:hover span.inner,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-day.date-disabled:hover span.inner{
|
||||
border-color: transparent;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr th.calendar-week.date-select span.inner,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-day.date-select span.inner,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr th.calendar-week.date-select:hover span.inner,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-day.date-select:hover span.inner{
|
||||
color: var(--color-fontsec);
|
||||
border-color: var(--color-fontsec);
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-month,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-year,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-decade{
|
||||
width: 33.33333333%;
|
||||
height: 40px;
|
||||
transition: color 142ms linear;
|
||||
-webkit-transition: color 142ms linear;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-month.date-today:before,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-year.date-today:before,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-decade.date-today:before{
|
||||
left: 50%;
|
||||
margin-left: -2.5px;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-month span.inner,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-year span.inner,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-decade span.inner{
|
||||
width: auto;
|
||||
height: 31px;
|
||||
line-height: 29px;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-month span.inner:before,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-year span.inner:before,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-decade span.inner:before,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-month span.inner:after,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-year span.inner:after,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-decade span.inner:after{
|
||||
width: 20px;
|
||||
height: 20px;
|
||||
content: "";
|
||||
z-index: 15;
|
||||
display: inline-block;
|
||||
position: absolute;
|
||||
border-width: 1px;
|
||||
border-style: solid;
|
||||
border-color: transparent;
|
||||
transition: all 142ms linear;
|
||||
-webkit-transition: all 142ms linear;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-month span.inner:before,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-year span.inner:before,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-decade span.inner:before{
|
||||
top: 0;
|
||||
left: 0;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-month:hover span.inner:before,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-year:hover span.inner:before,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-decade:hover span.inner:before{
|
||||
top: 6px;
|
||||
left: 6px;
|
||||
border-top-color: #cccccc;
|
||||
border-left-color: #cccccc;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-month span.inner:after,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-year span.inner:after,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-decade span.inner:after{
|
||||
right: 0;
|
||||
bottom: 0;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-month:hover span.inner:after,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-year:hover span.inner:after,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-decade:hover span.inner:after{
|
||||
right: 6px;
|
||||
bottom: 6px;
|
||||
border-right-color: #cccccc;
|
||||
border-bottom-color: #cccccc;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-year,
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-decade{
|
||||
width: 25%;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-datepicker table tr td.calendar-decade span.inner{
|
||||
height: 54px;
|
||||
padding: 7px 15px;
|
||||
text-align: left;
|
||||
line-height: 20px;
|
||||
}
|
||||
/* @end CALENDAR DATEPICKER */
|
||||
|
||||
/* @start CALENDAR TIMEPICKER */
|
||||
.tail-datetime-calendar .calendar-timepicker{
|
||||
width: 100%;
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
display: block;
|
||||
text-align: center;
|
||||
border-width: 1px 0 0 0;
|
||||
border-style: solid;
|
||||
border-color: #d9d9d9;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field{
|
||||
width: 28%;
|
||||
margin: 0;
|
||||
padding: 15px 0 7px 0;
|
||||
display: inline-block;
|
||||
position: relative;
|
||||
text-align: center;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field:first-of-type{
|
||||
text-align: right;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field:last-of-type{
|
||||
text-align: left;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field input[type="text"]{
|
||||
color: #303438;
|
||||
width: 100%;
|
||||
height: 29px;
|
||||
margin: 0;
|
||||
z-index: 4;
|
||||
padding: 3px 20px 3px 5px;
|
||||
outline: 0;
|
||||
display: inline-block;
|
||||
position: relative;
|
||||
font-size: 12px;
|
||||
text-align: center;
|
||||
line-height: 23px;
|
||||
appearance: textfield;
|
||||
-moz-appearance: textfield;
|
||||
-webkit-appearance: textfield;
|
||||
background-color: #F0F0F0;
|
||||
border-width: 0;
|
||||
border-style: solid;
|
||||
border-color: transparent;
|
||||
border-radius: 3px;
|
||||
box-shadow: none;
|
||||
-webkit-box-shadow: none;
|
||||
transition: color 142ms linear, border 142ms linear, background 142ms linear;
|
||||
-webkit-transition: color 142ms linear, border 142ms linear, background 142ms linear;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field input[type="text"]:hover{
|
||||
color: #303438;
|
||||
background-color: #E0E0E0;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field input[type="text"]:focus{
|
||||
color: #303438;
|
||||
background-color: #E0E0E0;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field input[type="text"]:disabled{
|
||||
cursor: not-allowed;
|
||||
color: #A0A4A8;
|
||||
background-color: #F6F6F6;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field button.picker-step{
|
||||
min-width: 0px;
|
||||
width: 20px;
|
||||
height: 15px;
|
||||
right: 0;
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
z-index: 15;
|
||||
display: inline-block;
|
||||
position: absolute;
|
||||
background-color: #F0F0F0;
|
||||
box-shadow: none;
|
||||
-webkit-box-shadow: none;
|
||||
transition: border 142ms linear, background 142ms linear;
|
||||
-webkit-transition: border 142ms linear, background 142ms linear;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field button.picker-step:before{
|
||||
top: 4px;
|
||||
left: 50%;
|
||||
width: 0;
|
||||
height: 0;
|
||||
margin: 0 0 0 -4px;
|
||||
padding: 0;
|
||||
content: "";
|
||||
display: inline-block;
|
||||
position: absolute;
|
||||
transition: border 142ms linear;
|
||||
-webkit-transition: border 142ms linear;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field button.picker-step.step-up{
|
||||
top: 15px;
|
||||
border-width: 0 0 1px 1px;
|
||||
border-style: solid;
|
||||
border-color: white;
|
||||
border-radius: 0 2px 0 0;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field button.picker-step.step-up:hover{
|
||||
background-color: #E0E0E0;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field button.picker-step.step-up:before{
|
||||
border-width: 0 4px 5px 4px;
|
||||
border-style: solid;
|
||||
border-color: transparent transparent #303438 transparent;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field button.picker-step.step-down{
|
||||
top: 29px;
|
||||
border-width: 1px 0 0 1px;
|
||||
border-style: solid;
|
||||
border-color: white;
|
||||
border-radius: 0 0 2px 0;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field button.picker-step.step-down:hover{
|
||||
background-color: #E0E0E0;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field button.picker-step.step-down:before{
|
||||
border-width: 5px 4px 0 4px;
|
||||
border-style: solid;
|
||||
border-color: #303438 transparent transparent transparent;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field input:focus + button.step-up{
|
||||
border-color: rgba(255, 255, 255, 0.8);
|
||||
background-color: var(--color-primary);
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field input:focus + button.step-up:hover{
|
||||
background-color: var(--color-dark);
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field input:focus + button.step-up:before{
|
||||
border-bottom-color: white;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field input:focus + button + button.step-down{
|
||||
border-color: rgba(255, 255, 255, 0.8);
|
||||
background-color: var(--color-primary);
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field input:focus + button + button.step-down:hover{
|
||||
background-color: var(--color-dark);
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field input:focus + button + button.step-down:before{
|
||||
border-top-color: white;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field input:disabled + button.step-up{
|
||||
cursor: not-allowed;
|
||||
border-color: rgba(255, 255, 255, 0.8);
|
||||
background-color: #F6F6F6;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field input:disabled + button.step-up:hover{
|
||||
background-color: #F6F6F6;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field input:disabled + button.step-up:before{
|
||||
border-bottom-color: #A0A4A8;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field input:disabled + button + button.step-down{
|
||||
cursor: not-allowed;
|
||||
border-color: rgba(255, 255, 255, 0.8);
|
||||
background-color: #F6F6F6;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field input:disabled + button + button.step-down:hover{
|
||||
background-color: #F6F6F6;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field input:disabled + button + button.step-down:before{
|
||||
border-top-color: #A0A4A8;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker .timepicker-field label{
|
||||
color: #303438;
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
display: block;
|
||||
font-size: 12px;
|
||||
text-align: center;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker label.timepicker-switch{
|
||||
cursor: pointer;
|
||||
margin: 15px 0 -5px 0;
|
||||
display: block;
|
||||
text-align: center;
|
||||
vertical-align: top;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker label.timepicker-switch:before,
|
||||
.tail-datetime-calendar .calendar-timepicker label.timepicker-switch:after{
|
||||
width: auto;
|
||||
margin: 0;
|
||||
padding: 0 5px;
|
||||
font-size: 12px;
|
||||
line-height: 16px;
|
||||
vertical-align: top;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker label.timepicker-switch:before{
|
||||
content: attr(data-am);
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker label.timepicker-switch:after{
|
||||
content: attr(data-pm);
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker label.timepicker-switch input[type="checkbox"]{
|
||||
display: none;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker label.timepicker-switch input[type="checkbox"] + span{
|
||||
display: inline-block;
|
||||
position: relative;
|
||||
vertical-align: top;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker label.timepicker-switch input[type="checkbox"] + span:before{
|
||||
width: 50px;
|
||||
height: 16px;
|
||||
content: "";
|
||||
display: inline-block;
|
||||
vertical-align: top;
|
||||
border-width: 1px;
|
||||
border-style: solid;
|
||||
border-color: var(--color-primary);
|
||||
border-radius: 14px;
|
||||
transition: border 284ms linear;
|
||||
-webkit-transition: border 284ms linear;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker label.timepicker-switch input[type="checkbox"] + span:after{
|
||||
top: 3px;
|
||||
left: 4px;
|
||||
right: 30px;
|
||||
width: auto;
|
||||
height: 10px;
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
content: "";
|
||||
display: inline-block;
|
||||
position: absolute;
|
||||
background-color: var(--color-primary);
|
||||
border-radius: 15px;
|
||||
vertical-align: top;
|
||||
transition: left 284ms linear, right 284ms linear 284ms, background 284ms linear;
|
||||
-webkit-transition: left 284ms linear, right 284ms linear 284ms, background 284ms linear;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker label.timepicker-switch input[type="checkbox"]:checked + span:before{
|
||||
border-color: #E67D1E;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-timepicker label.timepicker-switch input[type="checkbox"]:checked + span:after{
|
||||
left: 30px;
|
||||
right: 4px;
|
||||
background-color: #E67D1E;
|
||||
transition: right 284ms linear, left 284ms linear 284ms, background 284ms linear;
|
||||
-webkit-transition: right 284ms linear, left 284ms linear 284ms, background 284ms linear;
|
||||
}
|
||||
.tail-datetime-calendar .calendar-actions + .calendar-timepicker{
|
||||
border-width: 0;
|
||||
}
|
||||
/* @end CALENDAR TIMEPICKER */
|
||||
|
||||
/* @start RTL */
|
||||
.tail-datetime-calendar.rtl{
|
||||
direction: rtl;
|
||||
}
|
||||
.tail-datetime-calendar.rtl .calendar-actions span.action-next,
|
||||
.tail-datetime-calendar.rtl .calendar-actions span.action-prev{
|
||||
transform: rotate(180deg);
|
||||
-moz-transform: rotate(180deg);
|
||||
-webkit-transform: rotate(180deg);
|
||||
}
|
||||
.tail-datetime-calendar.rtl .calendar-datepicker table tr td.date-disabled:after{
|
||||
right: 3px;
|
||||
transform: rotate(45deg);
|
||||
-moz-transform: rotate(45deg);
|
||||
-webkit-transform: rotate(45deg);
|
||||
}
|
||||
.tail-datetime-calendar.rtl .calendar-datepicker table tr td.date-today:before{
|
||||
right: 5px;
|
||||
}
|
||||
.tail-datetime-calendar.rtl .calendar-datepicker table tr td .tooltip-tick{
|
||||
left: 5px;
|
||||
}
|
||||
.tail-datetime-calendar.rtl .calendar-datepicker table tr td.calendar-month.date-today:before,
|
||||
.tail-datetime-calendar.rtl .calendar-datepicker table tr td.calendar-year.date-today:before,
|
||||
.tail-datetime-calendar.rtl .calendar-datepicker table tr td.calendar-decade.date-today:before{
|
||||
right: 50%;
|
||||
margin-right: -2.5px;
|
||||
}
|
||||
.tail-datetime-calendar.rtl .calendar-datepicker table tr td.calendar-month:hover span.inner:before,
|
||||
.tail-datetime-calendar.rtl .calendar-datepicker table tr td.calendar-year:hover span.inner:before,
|
||||
.tail-datetime-calendar.rtl .calendar-datepicker table tr td.calendar-decade:hover span.inner:before{
|
||||
right: 6px;
|
||||
border-right-color: #cccccc;
|
||||
}
|
||||
.tail-datetime-calendar.rtl .calendar-datepicker table tr td.calendar-month span.inner:after,
|
||||
.tail-datetime-calendar.rtl .calendar-datepicker table tr td.calendar-year span.inner:after,
|
||||
.tail-datetime-calendar.rtl .calendar-datepicker table tr td.calendar-decade span.inner:after{
|
||||
left: 0;
|
||||
}
|
||||
.tail-datetime-calendar.rtl .calendar-datepicker table tr td.calendar-month:hover span.inner:after,
|
||||
.tail-datetime-calendar.rtl .calendar-datepicker table tr td.calendar-year:hover span.inner:after,
|
||||
.tail-datetime-calendar.rtl .calendar-datepicker table tr td.calendar-decade:hover span.inner:after{
|
||||
left: 6px;
|
||||
border-left-color: #cccccc;
|
||||
}
|
||||
.tail-datetime-calendar.rtl .calendar-datepicker table tr td.calendar-decade span.inner{
|
||||
text-align: right;
|
||||
}
|
||||
.tail-datetime-calendar.rtl .calendar-timepicker .timepicker-field:first-child{
|
||||
text-align: left;
|
||||
padding-left: 0;
|
||||
padding-right: 25px;
|
||||
}
|
||||
.tail-datetime-calendar.rtl .calendar-timepicker .timepicker-field:last-child{
|
||||
text-align: right;
|
||||
padding-left: 25px;
|
||||
padding-right: 0;
|
||||
}
|
||||
.tail-datetime-calendar.rtl .calendar-timepicker .timepicker-field:first-child input[type="text"]{
|
||||
margin-left: -1px;
|
||||
margin-right: 0;
|
||||
border-radius: 0 3px 3px 0;
|
||||
}
|
||||
.tail-datetime-calendar.rtl .calendar-timepicker .timepicker-field:last-child input[type="text"]{
|
||||
margin-left: 0;
|
||||
margin-right: -1px;
|
||||
border-radius: 3px 0 0 3px;
|
||||
}
|
||||
/* @end RTL */
|
||||
|
||||
/*# sourceMappingURL=tail.datetime-default-green.map */
|
||||
755
frontend/vendor/flatpickr.css
vendored
755
frontend/vendor/flatpickr.css
vendored
@ -1,755 +0,0 @@
|
||||
/*
|
||||
custom code
|
||||
hides the up/down arrows in time (number) inputs
|
||||
*/
|
||||
/* webkit */
|
||||
.flatpickr-calendar input[type=number]::-webkit-inner-spin-button,
|
||||
.flatpickr-calendar input[type=number]::-webkit-outer-spin-button {
|
||||
-webkit-appearance: none;
|
||||
margin: 0;
|
||||
}
|
||||
/* firefox */
|
||||
.flatpickr-calendar input[type=number] {
|
||||
-moz-appearance:textfield;
|
||||
}
|
||||
/* vendor code */
|
||||
.flatpickr-calendar {
|
||||
background: transparent;
|
||||
opacity: 0;
|
||||
display: none;
|
||||
text-align: center;
|
||||
visibility: hidden;
|
||||
padding: 0;
|
||||
-webkit-animation: none;
|
||||
animation: none;
|
||||
direction: ltr;
|
||||
border: 0;
|
||||
font-size: 14px;
|
||||
line-height: 24px;
|
||||
border-radius: 5px;
|
||||
position: absolute;
|
||||
width: 307.875px;
|
||||
-webkit-box-sizing: border-box;
|
||||
box-sizing: border-box;
|
||||
-ms-touch-action: manipulation;
|
||||
touch-action: manipulation;
|
||||
background: #fff;
|
||||
-webkit-box-shadow: 1px 0 0 #e6e6e6, -1px 0 0 #e6e6e6, 0 1px 0 #e6e6e6, 0 -1px 0 #e6e6e6, 0 3px 13px rgba(0,0,0,0.08);
|
||||
box-shadow: 1px 0 0 #e6e6e6, -1px 0 0 #e6e6e6, 0 1px 0 #e6e6e6, 0 -1px 0 #e6e6e6, 0 3px 13px rgba(0,0,0,0.08);
|
||||
}
|
||||
.flatpickr-calendar.open,
|
||||
.flatpickr-calendar.inline {
|
||||
opacity: 1;
|
||||
max-height: 640px;
|
||||
visibility: visible;
|
||||
}
|
||||
.flatpickr-calendar.open {
|
||||
display: inline-block;
|
||||
z-index: 99999;
|
||||
}
|
||||
.flatpickr-calendar.animate.open {
|
||||
-webkit-animation: fpFadeInDown 300ms cubic-bezier(0.23, 1, 0.32, 1);
|
||||
animation: fpFadeInDown 300ms cubic-bezier(0.23, 1, 0.32, 1);
|
||||
}
|
||||
.flatpickr-calendar.inline {
|
||||
display: block;
|
||||
position: relative;
|
||||
top: 2px;
|
||||
}
|
||||
.flatpickr-calendar.static {
|
||||
position: absolute;
|
||||
top: calc(100% + 2px);
|
||||
}
|
||||
.flatpickr-calendar.static.open {
|
||||
z-index: 999;
|
||||
display: block;
|
||||
}
|
||||
.flatpickr-calendar.multiMonth .flatpickr-days .dayContainer:nth-child(n+1) .flatpickr-day.inRange:nth-child(7n+7) {
|
||||
-webkit-box-shadow: none !important;
|
||||
box-shadow: none !important;
|
||||
}
|
||||
.flatpickr-calendar.multiMonth .flatpickr-days .dayContainer:nth-child(n+2) .flatpickr-day.inRange:nth-child(7n+1) {
|
||||
-webkit-box-shadow: -2px 0 0 #e6e6e6, 5px 0 0 #e6e6e6;
|
||||
box-shadow: -2px 0 0 #e6e6e6, 5px 0 0 #e6e6e6;
|
||||
}
|
||||
.flatpickr-calendar .hasWeeks .dayContainer,
|
||||
.flatpickr-calendar .hasTime .dayContainer {
|
||||
border-bottom: 0;
|
||||
border-bottom-right-radius: 0;
|
||||
border-bottom-left-radius: 0;
|
||||
}
|
||||
.flatpickr-calendar .hasWeeks .dayContainer {
|
||||
border-left: 0;
|
||||
}
|
||||
.flatpickr-calendar.showTimeInput.hasTime .flatpickr-time {
|
||||
height: 40px;
|
||||
border-top: 1px solid #e6e6e6;
|
||||
}
|
||||
.flatpickr-calendar.noCalendar.hasTime .flatpickr-time {
|
||||
height: auto;
|
||||
}
|
||||
.flatpickr-calendar:before,
|
||||
.flatpickr-calendar:after {
|
||||
position: absolute;
|
||||
display: block;
|
||||
pointer-events: none;
|
||||
border: solid transparent;
|
||||
content: '';
|
||||
height: 0;
|
||||
width: 0;
|
||||
left: 22px;
|
||||
}
|
||||
.flatpickr-calendar.rightMost:before,
|
||||
.flatpickr-calendar.rightMost:after {
|
||||
left: auto;
|
||||
right: 22px;
|
||||
}
|
||||
.flatpickr-calendar:before {
|
||||
border-width: 5px;
|
||||
margin: 0 -5px;
|
||||
}
|
||||
.flatpickr-calendar:after {
|
||||
border-width: 4px;
|
||||
margin: 0 -4px;
|
||||
}
|
||||
.flatpickr-calendar.arrowTop:before,
|
||||
.flatpickr-calendar.arrowTop:after {
|
||||
bottom: 100%;
|
||||
}
|
||||
.flatpickr-calendar.arrowTop:before {
|
||||
border-bottom-color: #e6e6e6;
|
||||
}
|
||||
.flatpickr-calendar.arrowTop:after {
|
||||
border-bottom-color: #fff;
|
||||
}
|
||||
.flatpickr-calendar.arrowBottom:before,
|
||||
.flatpickr-calendar.arrowBottom:after {
|
||||
top: 100%;
|
||||
}
|
||||
.flatpickr-calendar.arrowBottom:before {
|
||||
border-top-color: #e6e6e6;
|
||||
}
|
||||
.flatpickr-calendar.arrowBottom:after {
|
||||
border-top-color: #fff;
|
||||
}
|
||||
.flatpickr-calendar:focus {
|
||||
outline: 0;
|
||||
}
|
||||
.flatpickr-wrapper {
|
||||
position: relative;
|
||||
display: inline-block;
|
||||
}
|
||||
.flatpickr-months {
|
||||
display: -webkit-box;
|
||||
display: -webkit-flex;
|
||||
display: -ms-flexbox;
|
||||
display: flex;
|
||||
}
|
||||
.flatpickr-months .flatpickr-month {
|
||||
background: transparent;
|
||||
color: rgba(0,0,0,0.9);
|
||||
fill: rgba(0,0,0,0.9);
|
||||
height: 28px;
|
||||
line-height: 1;
|
||||
text-align: center;
|
||||
position: relative;
|
||||
-webkit-user-select: none;
|
||||
-moz-user-select: none;
|
||||
-ms-user-select: none;
|
||||
user-select: none;
|
||||
overflow: hidden;
|
||||
-webkit-box-flex: 1;
|
||||
-webkit-flex: 1;
|
||||
-ms-flex: 1;
|
||||
flex: 1;
|
||||
}
|
||||
.flatpickr-months .flatpickr-prev-month,
|
||||
.flatpickr-months .flatpickr-next-month {
|
||||
text-decoration: none;
|
||||
cursor: pointer;
|
||||
position: absolute;
|
||||
top: 0px;
|
||||
line-height: 16px;
|
||||
height: 28px;
|
||||
padding: 10px;
|
||||
z-index: 3;
|
||||
}
|
||||
.flatpickr-months .flatpickr-prev-month.disabled,
|
||||
.flatpickr-months .flatpickr-next-month.disabled {
|
||||
display: none;
|
||||
}
|
||||
.flatpickr-months .flatpickr-prev-month i,
|
||||
.flatpickr-months .flatpickr-next-month i {
|
||||
position: relative;
|
||||
}
|
||||
.flatpickr-months .flatpickr-prev-month.flatpickr-prev-month,
|
||||
.flatpickr-months .flatpickr-next-month.flatpickr-prev-month {
|
||||
/*
|
||||
/*rtl:begin:ignore*/
|
||||
/*
|
||||
*/
|
||||
left: 0;
|
||||
/*
|
||||
/*rtl:end:ignore*/
|
||||
/*
|
||||
*/
|
||||
}
|
||||
/*
|
||||
/*rtl:begin:ignore*/
|
||||
/*
|
||||
/*rtl:end:ignore*/
|
||||
.flatpickr-months .flatpickr-prev-month.flatpickr-next-month,
|
||||
.flatpickr-months .flatpickr-next-month.flatpickr-next-month {
|
||||
/*
|
||||
/*rtl:begin:ignore*/
|
||||
/*
|
||||
*/
|
||||
right: 0;
|
||||
/*
|
||||
/*rtl:end:ignore*/
|
||||
/*
|
||||
*/
|
||||
}
|
||||
/*
|
||||
/*rtl:begin:ignore*/
|
||||
/*
|
||||
/*rtl:end:ignore*/
|
||||
.flatpickr-months .flatpickr-prev-month:hover,
|
||||
.flatpickr-months .flatpickr-next-month:hover {
|
||||
color: #959ea9;
|
||||
}
|
||||
.flatpickr-months .flatpickr-prev-month:hover svg,
|
||||
.flatpickr-months .flatpickr-next-month:hover svg {
|
||||
fill: #f64747;
|
||||
}
|
||||
.flatpickr-months .flatpickr-prev-month svg,
|
||||
.flatpickr-months .flatpickr-next-month svg {
|
||||
width: 14px;
|
||||
height: 14px;
|
||||
}
|
||||
.flatpickr-months .flatpickr-prev-month svg path,
|
||||
.flatpickr-months .flatpickr-next-month svg path {
|
||||
-webkit-transition: fill 0.1s;
|
||||
transition: fill 0.1s;
|
||||
fill: inherit;
|
||||
}
|
||||
.numInputWrapper {
|
||||
position: relative;
|
||||
height: auto;
|
||||
}
|
||||
.numInputWrapper input,
|
||||
.numInputWrapper span {
|
||||
display: inline-block;
|
||||
}
|
||||
.numInputWrapper input {
|
||||
width: 100%;
|
||||
min-width: auto !important;
|
||||
}
|
||||
.numInputWrapper input::-ms-clear {
|
||||
display: none;
|
||||
}
|
||||
.numInputWrapper span {
|
||||
position: absolute;
|
||||
right: 0;
|
||||
width: 14px;
|
||||
padding: 0 4px 0 2px;
|
||||
height: 50%;
|
||||
line-height: 50%;
|
||||
opacity: 0;
|
||||
cursor: pointer;
|
||||
border: 1px solid rgba(57,57,57,0.15);
|
||||
-webkit-box-sizing: border-box;
|
||||
box-sizing: border-box;
|
||||
}
|
||||
.numInputWrapper span:hover {
|
||||
background: rgba(0,0,0,0.1);
|
||||
}
|
||||
.numInputWrapper span:active {
|
||||
background: rgba(0,0,0,0.2);
|
||||
}
|
||||
.numInputWrapper span:after {
|
||||
display: block;
|
||||
content: '';
|
||||
position: absolute;
|
||||
}
|
||||
.numInputWrapper span.arrowUp {
|
||||
top: 0;
|
||||
border-bottom: 0;
|
||||
}
|
||||
.numInputWrapper span.arrowUp:after {
|
||||
border-left: 4px solid transparent;
|
||||
border-right: 4px solid transparent;
|
||||
border-bottom: 4px solid rgba(57,57,57,0.6);
|
||||
top: 26%;
|
||||
}
|
||||
.numInputWrapper span.arrowDown {
|
||||
top: 50%;
|
||||
}
|
||||
.numInputWrapper span.arrowDown:after {
|
||||
border-left: 4px solid transparent;
|
||||
border-right: 4px solid transparent;
|
||||
border-top: 4px solid rgba(57,57,57,0.6);
|
||||
top: 40%;
|
||||
}
|
||||
.numInputWrapper span svg {
|
||||
width: inherit;
|
||||
height: auto;
|
||||
}
|
||||
.numInputWrapper span svg path {
|
||||
fill: rgba(0,0,0,0.5);
|
||||
}
|
||||
.numInputWrapper:hover {
|
||||
background: rgba(0,0,0,0.05);
|
||||
}
|
||||
.numInputWrapper:hover span {
|
||||
opacity: 1;
|
||||
}
|
||||
.flatpickr-current-month {
|
||||
font-size: 135%;
|
||||
line-height: inherit;
|
||||
font-weight: 300;
|
||||
color: inherit;
|
||||
position: absolute;
|
||||
width: 75%;
|
||||
left: 12.5%;
|
||||
padding: 6.16px 0 0 0;
|
||||
line-height: 1;
|
||||
height: 28px;
|
||||
display: inline-block;
|
||||
text-align: center;
|
||||
-webkit-transform: translate3d(0px, 0px, 0px);
|
||||
transform: translate3d(0px, 0px, 0px);
|
||||
}
|
||||
.flatpickr-current-month span.cur-month {
|
||||
font-family: inherit;
|
||||
font-weight: 700;
|
||||
color: inherit;
|
||||
display: inline-block;
|
||||
margin-left: 0.5ch;
|
||||
padding: 0;
|
||||
}
|
||||
.flatpickr-current-month span.cur-month:hover {
|
||||
background: rgba(0,0,0,0.05);
|
||||
}
|
||||
.flatpickr-current-month .numInputWrapper {
|
||||
width: 6ch;
|
||||
width: 7ch\0;
|
||||
display: inline-block;
|
||||
}
|
||||
.flatpickr-current-month .numInputWrapper span.arrowUp:after {
|
||||
border-bottom-color: rgba(0,0,0,0.9);
|
||||
}
|
||||
.flatpickr-current-month .numInputWrapper span.arrowDown:after {
|
||||
border-top-color: rgba(0,0,0,0.9);
|
||||
}
|
||||
.flatpickr-current-month input.cur-year {
|
||||
background: transparent;
|
||||
-webkit-box-sizing: border-box;
|
||||
box-sizing: border-box;
|
||||
color: inherit;
|
||||
cursor: text;
|
||||
padding: 0 0 0 0.5ch;
|
||||
margin: 0;
|
||||
display: inline-block;
|
||||
font-size: inherit;
|
||||
font-family: inherit;
|
||||
font-weight: 300;
|
||||
line-height: inherit;
|
||||
height: auto;
|
||||
border: 0;
|
||||
border-radius: 0;
|
||||
vertical-align: initial;
|
||||
}
|
||||
.flatpickr-current-month input.cur-year:focus {
|
||||
outline: 0;
|
||||
}
|
||||
.flatpickr-current-month input.cur-year[disabled],
|
||||
.flatpickr-current-month input.cur-year[disabled]:hover {
|
||||
font-size: 100%;
|
||||
color: rgba(0,0,0,0.5);
|
||||
background: transparent;
|
||||
pointer-events: none;
|
||||
}
|
||||
.flatpickr-weekdays {
|
||||
background: transparent;
|
||||
text-align: center;
|
||||
overflow: hidden;
|
||||
width: 100%;
|
||||
display: -webkit-box;
|
||||
display: -webkit-flex;
|
||||
display: -ms-flexbox;
|
||||
display: flex;
|
||||
-webkit-box-align: center;
|
||||
-webkit-align-items: center;
|
||||
-ms-flex-align: center;
|
||||
align-items: center;
|
||||
height: 28px;
|
||||
}
|
||||
.flatpickr-weekdays .flatpickr-weekdaycontainer {
|
||||
display: -webkit-box;
|
||||
display: -webkit-flex;
|
||||
display: -ms-flexbox;
|
||||
display: flex;
|
||||
-webkit-box-flex: 1;
|
||||
-webkit-flex: 1;
|
||||
-ms-flex: 1;
|
||||
flex: 1;
|
||||
}
|
||||
span.flatpickr-weekday {
|
||||
cursor: default;
|
||||
font-size: 90%;
|
||||
background: transparent;
|
||||
color: rgba(0,0,0,0.54);
|
||||
line-height: 1;
|
||||
margin: 0;
|
||||
text-align: center;
|
||||
display: block;
|
||||
-webkit-box-flex: 1;
|
||||
-webkit-flex: 1;
|
||||
-ms-flex: 1;
|
||||
flex: 1;
|
||||
font-weight: bolder;
|
||||
}
|
||||
.dayContainer,
|
||||
.flatpickr-weeks {
|
||||
padding: 1px 0 0 0;
|
||||
}
|
||||
.flatpickr-days {
|
||||
position: relative;
|
||||
overflow: hidden;
|
||||
display: -webkit-box;
|
||||
display: -webkit-flex;
|
||||
display: -ms-flexbox;
|
||||
display: flex;
|
||||
-webkit-box-align: start;
|
||||
-webkit-align-items: flex-start;
|
||||
-ms-flex-align: start;
|
||||
align-items: flex-start;
|
||||
width: 307.875px;
|
||||
}
|
||||
.flatpickr-days:focus {
|
||||
outline: 0;
|
||||
}
|
||||
.dayContainer {
|
||||
padding: 0;
|
||||
outline: 0;
|
||||
text-align: left;
|
||||
width: 307.875px;
|
||||
min-width: 307.875px;
|
||||
max-width: 307.875px;
|
||||
-webkit-box-sizing: border-box;
|
||||
box-sizing: border-box;
|
||||
display: inline-block;
|
||||
display: -ms-flexbox;
|
||||
display: -webkit-box;
|
||||
display: -webkit-flex;
|
||||
display: flex;
|
||||
-webkit-flex-wrap: wrap;
|
||||
flex-wrap: wrap;
|
||||
-ms-flex-wrap: wrap;
|
||||
-ms-flex-pack: justify;
|
||||
-webkit-justify-content: space-around;
|
||||
justify-content: space-around;
|
||||
-webkit-transform: translate3d(0px, 0px, 0px);
|
||||
transform: translate3d(0px, 0px, 0px);
|
||||
opacity: 1;
|
||||
}
|
||||
.dayContainer + .dayContainer {
|
||||
-webkit-box-shadow: -1px 0 0 #e6e6e6;
|
||||
box-shadow: -1px 0 0 #e6e6e6;
|
||||
}
|
||||
.flatpickr-day {
|
||||
background: none;
|
||||
border: 1px solid transparent;
|
||||
border-radius: 150px;
|
||||
-webkit-box-sizing: border-box;
|
||||
box-sizing: border-box;
|
||||
color: #393939;
|
||||
cursor: pointer;
|
||||
font-weight: 400;
|
||||
width: 14.2857143%;
|
||||
-webkit-flex-basis: 14.2857143%;
|
||||
-ms-flex-preferred-size: 14.2857143%;
|
||||
flex-basis: 14.2857143%;
|
||||
max-width: 39px;
|
||||
height: 39px;
|
||||
line-height: 39px;
|
||||
margin: 0;
|
||||
display: inline-block;
|
||||
position: relative;
|
||||
-webkit-box-pack: center;
|
||||
-webkit-justify-content: center;
|
||||
-ms-flex-pack: center;
|
||||
justify-content: center;
|
||||
text-align: center;
|
||||
}
|
||||
.flatpickr-day.inRange,
|
||||
.flatpickr-day.prevMonthDay.inRange,
|
||||
.flatpickr-day.nextMonthDay.inRange,
|
||||
.flatpickr-day.today.inRange,
|
||||
.flatpickr-day.prevMonthDay.today.inRange,
|
||||
.flatpickr-day.nextMonthDay.today.inRange,
|
||||
.flatpickr-day:hover,
|
||||
.flatpickr-day.prevMonthDay:hover,
|
||||
.flatpickr-day.nextMonthDay:hover,
|
||||
.flatpickr-day:focus,
|
||||
.flatpickr-day.prevMonthDay:focus,
|
||||
.flatpickr-day.nextMonthDay:focus {
|
||||
cursor: pointer;
|
||||
outline: 0;
|
||||
background: #e6e6e6;
|
||||
border-color: #e6e6e6;
|
||||
}
|
||||
.flatpickr-day.today {
|
||||
border-color: #959ea9;
|
||||
}
|
||||
.flatpickr-day.today:hover,
|
||||
.flatpickr-day.today:focus {
|
||||
border-color: #959ea9;
|
||||
background: #959ea9;
|
||||
color: #fff;
|
||||
}
|
||||
.flatpickr-day.selected,
|
||||
.flatpickr-day.startRange,
|
||||
.flatpickr-day.endRange,
|
||||
.flatpickr-day.selected.inRange,
|
||||
.flatpickr-day.startRange.inRange,
|
||||
.flatpickr-day.endRange.inRange,
|
||||
.flatpickr-day.selected:focus,
|
||||
.flatpickr-day.startRange:focus,
|
||||
.flatpickr-day.endRange:focus,
|
||||
.flatpickr-day.selected:hover,
|
||||
.flatpickr-day.startRange:hover,
|
||||
.flatpickr-day.endRange:hover,
|
||||
.flatpickr-day.selected.prevMonthDay,
|
||||
.flatpickr-day.startRange.prevMonthDay,
|
||||
.flatpickr-day.endRange.prevMonthDay,
|
||||
.flatpickr-day.selected.nextMonthDay,
|
||||
.flatpickr-day.startRange.nextMonthDay,
|
||||
.flatpickr-day.endRange.nextMonthDay {
|
||||
background: #569ff7;
|
||||
-webkit-box-shadow: none;
|
||||
box-shadow: none;
|
||||
color: #fff;
|
||||
border-color: #569ff7;
|
||||
}
|
||||
.flatpickr-day.selected.startRange,
|
||||
.flatpickr-day.startRange.startRange,
|
||||
.flatpickr-day.endRange.startRange {
|
||||
border-radius: 50px 0 0 50px;
|
||||
}
|
||||
.flatpickr-day.selected.endRange,
|
||||
.flatpickr-day.startRange.endRange,
|
||||
.flatpickr-day.endRange.endRange {
|
||||
border-radius: 0 50px 50px 0;
|
||||
}
|
||||
.flatpickr-day.selected.startRange + .endRange,
|
||||
.flatpickr-day.startRange.startRange + .endRange,
|
||||
.flatpickr-day.endRange.startRange + .endRange {
|
||||
-webkit-box-shadow: -10px 0 0 #569ff7;
|
||||
box-shadow: -10px 0 0 #569ff7;
|
||||
}
|
||||
.flatpickr-day.selected.startRange.endRange,
|
||||
.flatpickr-day.startRange.startRange.endRange,
|
||||
.flatpickr-day.endRange.startRange.endRange {
|
||||
border-radius: 50px;
|
||||
}
|
||||
.flatpickr-day.inRange {
|
||||
border-radius: 0;
|
||||
-webkit-box-shadow: -5px 0 0 #e6e6e6, 5px 0 0 #e6e6e6;
|
||||
box-shadow: -5px 0 0 #e6e6e6, 5px 0 0 #e6e6e6;
|
||||
}
|
||||
.flatpickr-day.disabled,
|
||||
.flatpickr-day.disabled:hover,
|
||||
.flatpickr-day.prevMonthDay,
|
||||
.flatpickr-day.nextMonthDay,
|
||||
.flatpickr-day.notAllowed,
|
||||
.flatpickr-day.notAllowed.prevMonthDay,
|
||||
.flatpickr-day.notAllowed.nextMonthDay {
|
||||
color: rgba(57,57,57,0.3);
|
||||
background: transparent;
|
||||
border-color: transparent;
|
||||
cursor: default;
|
||||
}
|
||||
.flatpickr-day.disabled,
|
||||
.flatpickr-day.disabled:hover {
|
||||
cursor: not-allowed;
|
||||
color: rgba(57,57,57,0.1);
|
||||
}
|
||||
.flatpickr-day.week.selected {
|
||||
border-radius: 0;
|
||||
-webkit-box-shadow: -5px 0 0 #569ff7, 5px 0 0 #569ff7;
|
||||
box-shadow: -5px 0 0 #569ff7, 5px 0 0 #569ff7;
|
||||
}
|
||||
.flatpickr-day.hidden {
|
||||
visibility: hidden;
|
||||
}
|
||||
.rangeMode .flatpickr-day {
|
||||
margin-top: 1px;
|
||||
}
|
||||
.flatpickr-weekwrapper {
|
||||
display: inline-block;
|
||||
float: left;
|
||||
}
|
||||
.flatpickr-weekwrapper .flatpickr-weeks {
|
||||
padding: 0 12px;
|
||||
-webkit-box-shadow: 1px 0 0 #e6e6e6;
|
||||
box-shadow: 1px 0 0 #e6e6e6;
|
||||
}
|
||||
.flatpickr-weekwrapper .flatpickr-weekday {
|
||||
float: none;
|
||||
width: 100%;
|
||||
line-height: 28px;
|
||||
}
|
||||
.flatpickr-weekwrapper span.flatpickr-day,
|
||||
.flatpickr-weekwrapper span.flatpickr-day:hover {
|
||||
display: block;
|
||||
width: 100%;
|
||||
max-width: none;
|
||||
color: rgba(57,57,57,0.3);
|
||||
background: transparent;
|
||||
cursor: default;
|
||||
border: none;
|
||||
}
|
||||
.flatpickr-innerContainer {
|
||||
display: block;
|
||||
display: -webkit-box;
|
||||
display: -webkit-flex;
|
||||
display: -ms-flexbox;
|
||||
display: flex;
|
||||
-webkit-box-sizing: border-box;
|
||||
box-sizing: border-box;
|
||||
overflow: hidden;
|
||||
}
|
||||
.flatpickr-rContainer {
|
||||
display: inline-block;
|
||||
padding: 0;
|
||||
-webkit-box-sizing: border-box;
|
||||
box-sizing: border-box;
|
||||
}
|
||||
.flatpickr-time {
|
||||
text-align: center;
|
||||
outline: 0;
|
||||
display: block;
|
||||
height: 0;
|
||||
line-height: 40px;
|
||||
max-height: 40px;
|
||||
-webkit-box-sizing: border-box;
|
||||
box-sizing: border-box;
|
||||
overflow: hidden;
|
||||
display: -webkit-box;
|
||||
display: -webkit-flex;
|
||||
display: -ms-flexbox;
|
||||
display: flex;
|
||||
}
|
||||
.flatpickr-time:after {
|
||||
content: '';
|
||||
display: table;
|
||||
clear: both;
|
||||
}
|
||||
.flatpickr-time .numInputWrapper {
|
||||
-webkit-box-flex: 1;
|
||||
-webkit-flex: 1;
|
||||
-ms-flex: 1;
|
||||
flex: 1;
|
||||
width: 40%;
|
||||
height: 40px;
|
||||
float: left;
|
||||
}
|
||||
.flatpickr-time .numInputWrapper span.arrowUp:after {
|
||||
border-bottom-color: #393939;
|
||||
}
|
||||
.flatpickr-time .numInputWrapper span.arrowDown:after {
|
||||
border-top-color: #393939;
|
||||
}
|
||||
.flatpickr-time.hasSeconds .numInputWrapper {
|
||||
width: 26%;
|
||||
}
|
||||
.flatpickr-time.time24hr .numInputWrapper {
|
||||
width: 49%;
|
||||
}
|
||||
.flatpickr-time input {
|
||||
background: transparent;
|
||||
-webkit-box-shadow: none;
|
||||
box-shadow: none;
|
||||
border: 0;
|
||||
border-radius: 0;
|
||||
text-align: center;
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
height: inherit;
|
||||
line-height: inherit;
|
||||
cursor: pointer;
|
||||
color: #393939;
|
||||
font-size: 14px;
|
||||
position: relative;
|
||||
-webkit-box-sizing: border-box;
|
||||
box-sizing: border-box;
|
||||
}
|
||||
.flatpickr-time input.flatpickr-hour {
|
||||
font-weight: bold;
|
||||
}
|
||||
.flatpickr-time input.flatpickr-minute,
|
||||
.flatpickr-time input.flatpickr-second {
|
||||
font-weight: 400;
|
||||
}
|
||||
.flatpickr-time input:focus {
|
||||
outline: 0;
|
||||
border: 0;
|
||||
}
|
||||
.flatpickr-time .flatpickr-time-separator,
|
||||
.flatpickr-time .flatpickr-am-pm {
|
||||
height: inherit;
|
||||
display: inline-block;
|
||||
float: left;
|
||||
line-height: inherit;
|
||||
color: #393939;
|
||||
font-weight: bold;
|
||||
width: 2%;
|
||||
-webkit-user-select: none;
|
||||
-moz-user-select: none;
|
||||
-ms-user-select: none;
|
||||
user-select: none;
|
||||
-webkit-align-self: center;
|
||||
-ms-flex-item-align: center;
|
||||
align-self: center;
|
||||
}
|
||||
.flatpickr-time .flatpickr-am-pm {
|
||||
outline: 0;
|
||||
width: 18%;
|
||||
cursor: pointer;
|
||||
text-align: center;
|
||||
font-weight: 400;
|
||||
}
|
||||
.flatpickr-time .flatpickr-am-pm:hover,
|
||||
.flatpickr-time .flatpickr-am-pm:focus {
|
||||
background: #f0f0f0;
|
||||
}
|
||||
.flatpickr-input[readonly] {
|
||||
cursor: pointer;
|
||||
min-width: auto;
|
||||
}
|
||||
@-webkit-keyframes fpFadeInDown {
|
||||
from {
|
||||
opacity: 0;
|
||||
-webkit-transform: translate3d(0, -20px, 0);
|
||||
transform: translate3d(0, -20px, 0);
|
||||
}
|
||||
to {
|
||||
opacity: 1;
|
||||
-webkit-transform: translate3d(0, 0, 0);
|
||||
transform: translate3d(0, 0, 0);
|
||||
}
|
||||
}
|
||||
@keyframes fpFadeInDown {
|
||||
from {
|
||||
opacity: 0;
|
||||
-webkit-transform: translate3d(0, -20px, 0);
|
||||
transform: translate3d(0, -20px, 0);
|
||||
}
|
||||
to {
|
||||
opacity: 1;
|
||||
-webkit-transform: translate3d(0, 0, 0);
|
||||
transform: translate3d(0, 0, 0);
|
||||
}
|
||||
}
|
||||
2
frontend/vendor/main.js
vendored
2
frontend/vendor/main.js
vendored
@ -1,2 +1,2 @@
|
||||
import './fontawesome.css';
|
||||
import './flatpickr.css';
|
||||
import './datetime.css';
|
||||
5
jsconfig.json
Normal file
5
jsconfig.json
Normal file
@ -0,0 +1,5 @@
|
||||
{
|
||||
"compilerOptions": {
|
||||
"experimentalDecorators": true
|
||||
},
|
||||
}
|
||||
@ -30,6 +30,7 @@ Aborted: Abgebrochen
|
||||
Remarks: Hinweise
|
||||
Registered: Angemeldet
|
||||
RegisteredSince: Angemeldet seit
|
||||
Registration: Anmeldung
|
||||
RegisterFrom: Anmeldungen von
|
||||
RegisterTo: Anmeldungen bis
|
||||
DeRegUntil: Abmeldungen bis
|
||||
@ -127,7 +128,7 @@ CourseShorthand: Kürzel
|
||||
CourseShorthandUnique: Muss innerhalb Institut und Semester eindeutig sein
|
||||
CourseSemester: Semester
|
||||
CourseSchool: Institut
|
||||
CourseSchoolShort: Fach
|
||||
CourseSchoolShort: Institut
|
||||
CourseSecretTip: Anmeldung zum Kurs erfordert Eingabe des Passworts, sofern gesetzt
|
||||
CourseSecretFormat: beliebige Zeichenkette
|
||||
CourseRegisterFromTip: Ohne Datum ist KEINE eigenständige Anmeldung von Studierenden möglich
|
||||
@ -170,6 +171,18 @@ CourseApplicationInstructionsRegistration: Anweisungen zur Anmeldung
|
||||
CourseApplicationTemplateApplication: Bewerbungsvorlage(n)
|
||||
CourseApplicationTemplateRegistration: Anmeldungsvorlage(n)
|
||||
CourseApplicationTemplateArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-bewerbungsvorlagen
|
||||
CourseApplication: Bewerbung
|
||||
|
||||
CourseApplicationExists: Sie haben sich bereits für diesen Kurs beworben
|
||||
CourseApplicationInvalidAction: Angegeben Aktion kann nicht durchgeführt werden
|
||||
CourseApplicationCreated csh@CourseShorthand: Erfolgreich zu #{csh} beworben
|
||||
CourseApplicationEdited csh@CourseShorthand: Bewerbung zu #{csh} erfolgreich angepasst
|
||||
CourseApplicationNotEdited csh@CourseShorthand: Bewerbung zu #{csh} hat sich nicht verändert
|
||||
CourseApplicationRated: Bewertung erfolgreich angepasst
|
||||
CourseApplicationRatingDeleted: Bewertung erfolgreich entfernt
|
||||
CourseApplicationDeleted csh@CourseShorthand: Bewerbung zu #{csh} erfolgreich zurückgezogen
|
||||
|
||||
CourseApplicationTitle displayName@Text csh@CourseShorthand: Bewerbung für #{csh}: #{displayName}
|
||||
|
||||
CourseApplicationText: Text-Bewerbung
|
||||
CourseApplicationFollowInstructions: Beachten Sie die Anweisungen zur Bewerbung!
|
||||
@ -178,11 +191,13 @@ CourseRegistrationFollowInstructions: Beachten Sie die Anweisungen zur Anmeldung
|
||||
|
||||
CourseApplicationFile: Bewerbung
|
||||
CourseApplicationFiles: Bewerbungsdatei(en)
|
||||
CourseApplicationArchive: Zip-Archiv der Bewerbungsdatei(en)
|
||||
CourseApplicationArchive: Zip-Archiv der Bewerbungsdatei(en)
|
||||
CourseRegistrationFile: Datei zur Anmeldung
|
||||
CourseRegistrationFiles: Datei(en) zur Anmeldung
|
||||
CourseRegistrationArchive: Zip-Archiv der Datei(en) zur Anmeldung
|
||||
CourseApplicationNoFiles: Keine Datei(en)
|
||||
CourseApplicationFilesNeedReupload: Bewerbungsdateien müssen neu hochgeladen werden, wann immer die Bewerbung angepasst wird
|
||||
CourseRegistrationFilesNeedReupload: Dateien zur Anmeldung müssen neu hochgeladen werden, wann immer die Anmeldung angepasst wird
|
||||
|
||||
CourseApplicationDeleteToEdit: Um Ihre Bewerbung zu editieren müssen Sie sie zunächst zurückziehen und sich erneut bewerben.
|
||||
CourseRegistrationDeleteToEdit: Um Ihre Anmeldungsdaten zu editieren müssen Sie sich zunächst ab- und dann erneut anmelden.
|
||||
@ -191,9 +206,12 @@ CourseLoginToApply: Um sich zum Kurz zu bewerben müssen Sie sich zunächst in U
|
||||
CourseLoginToRegister: Um sich zum Kurs anzumelden müssen Sie zunächst in Uni2work anmelden
|
||||
|
||||
CourseApplicationArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand appId@CryptoFileNameCourseApplication displayName@Text: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldCase (toPathPiece appId)}-#{foldCase displayName}
|
||||
CourseAllApplicationsArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-bewerbungen
|
||||
CourseApplicationsAllocatedDirectory: zentral
|
||||
CourseApplicationsNotAllocatedDirectory: direkt
|
||||
|
||||
CourseNoAllocationsAvailable: Es sind aktuell keine Zentralanmeldungen verfügbar
|
||||
AllocationStaffRegisterToExpired: Es dürfen keine Änderungen an der Eintragung des Kurses zur Zentralanmeldung mehr vorgenommen werden
|
||||
AllocationStaffRegisterToExpired: Es dürfen keine Änderungen an der Eintragung des Kurses zur Zentralanmeldung mehr vorgenommen werden. Ihre Änderungen wurden ignoriert.
|
||||
|
||||
|
||||
CourseFormSectionRegistration: Anmeldung zum Kurs
|
||||
@ -212,6 +230,8 @@ CourseAllocationCapacityMayNotBeChanged: Kapazität eines Kurses, der an einer Z
|
||||
|
||||
CourseLecturerRightsIdentical: Alle Sorten von Kursverwalter haben identische Rechte.
|
||||
|
||||
School: Institut
|
||||
|
||||
NoSuchTerm tid@TermId: Semester #{tid} gibt es nicht.
|
||||
NoSuchSchool ssh@SchoolId: Institut #{ssh} gibt es nicht.
|
||||
NoSuchCourseShorthand csh@CourseShorthand: Kein Kurs mit Kürzel #{csh} bekannt.
|
||||
@ -332,7 +352,7 @@ MaterialArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand materialName@Mat
|
||||
Unauthorized: Sie haben hierfür keine explizite Berechtigung.
|
||||
UnauthorizedAnd l@Text r@Text: (#{l} UND #{r})
|
||||
UnauthorizedOr l@Text r@Text: (#{l} ODER #{r})
|
||||
UnauthorizedNot i@Text: (NICHT #{i})
|
||||
UnauthorizedNot r@Text: (NICHT #{r})
|
||||
UnauthorizedNoToken: Ihrer Anfrage war kein Authorisierungs-Token beigefügt.
|
||||
UnauthorizedTokenExpired: Ihr Authorisierungs-Token ist abgelaufen.
|
||||
UnauthorizedTokenNotStarted: Ihr Authorisierungs-Token ist noch nicht gültig.
|
||||
@ -345,13 +365,16 @@ UnauthorizedSchoolAdmin: Sie sind nicht als Administrator für dieses Institut e
|
||||
UnauthorizedAdminEscalation: Sie sind nicht Administrator für alle Institute, für die dieser Nutzer Administrator oder Veranstalter ist.
|
||||
UnauthorizedSchoolLecturer: Sie sind nicht als Veranstalter für dieses Institut eingetragen.
|
||||
UnauthorizedLecturer: Sie sind nicht als Veranstalter für diese Veranstaltung eingetragen.
|
||||
UnauthorizedAllocationLecturer: Sie sind nicht als Veranstalter für eine Veranstaltung dieser Zentralanmeldung eingetragen.
|
||||
UnauthorizedCorrector: Sie sind nicht als Korrektor für diese Veranstaltung eingetragen.
|
||||
UnauthorizedSheetCorrector: Sie sind nicht als Korrektor für dieses Übungsblatt eingetragen.
|
||||
UnauthorizedCorrectorAny: Sie sind nicht als Korrektor für eine Veranstaltung eingetragen.
|
||||
UnauthorizedRegistered: Sie sind nicht als Teilnehmer für diese Veranstaltung registriert.
|
||||
UnauthorizedAllocationRegistered: Sie sind nicht als Teilnehmer für diese Zentralanmeldung registriert.
|
||||
UnauthorizedExamResult: Sie haben keine Ergebnisse in dieser Prüfung.
|
||||
UnauthorizedParticipant: Angegebener Benutzer ist nicht als Teilnehmer dieser Veranstaltung registriert.
|
||||
UnauthorizedCourseTime: Dieses Kurs erlaubt momentan keine Anmeldungen.
|
||||
UnauthorizedAllocationRegisterTime: Diese Zentralanmeldung erlaubt momentan keine Bewerbungen.
|
||||
UnauthorizedSheetTime: Dieses Übungsblatt ist momentan nicht freigegeben.
|
||||
UnauthorizedApplicationTime: Diese Bewerbung ist momentan nicht freigegeben.
|
||||
UnauthorizedMaterialTime: Dieses Material ist momentan nicht freigegeben.
|
||||
@ -369,7 +392,7 @@ MaterialFree: Kursmaterialien ohne Anmeldung zugänglich
|
||||
UnauthorizedWrite: Sie haben hierfür keine Schreibberechtigung
|
||||
UnauthorizedSystemMessageTime: Diese Systemnachricht ist noch nicht oder nicht mehr einsehbar.
|
||||
UnauthorizedSystemMessageAuth: Diese Systemnachricht ist nur für angemeldete Benutzer einsehbar.
|
||||
UnsupportedAuthPredicate authTagT@Text shownRoute@String: "#{authTagT}" wurde auf eine Route angewandt, die dies nicht unterstützt: #{shownRoute}
|
||||
UnsupportedAuthPredicate authTagT@Text shownRoute@Text: „#{authTagT}“ wurde auf eine Route angewandt, die dies nicht unterstützt: „#{shownRoute}“
|
||||
UnauthorizedDisabledTag authTag@AuthTag: Authorisierungsprädikat "#{toPathPiece authTag}" ist für Ihre Sitzung nicht aktiv
|
||||
UnknownAuthPredicate tag@String: Authorisierungsprädikat "#{tag}" ist dem System nicht bekannt
|
||||
UnauthorizedRedirect: Die angeforderte Seite existiert nicht oder Sie haben keine Berechtigung, die angeforderte Seite zu sehen.
|
||||
@ -433,7 +456,7 @@ NotificationSettingsHeading displayName@Text: Benachrichtigungs-Einstellungen f
|
||||
TokensLastReset: Tokens zuletzt invalidiert
|
||||
TokensResetSuccess: Authorisierungs-Tokens invalidiert
|
||||
|
||||
HomeOpenCourses: Kurse mit offener Registrierung
|
||||
HomeOpenAllocations: Offene Zentralanmeldungen
|
||||
HomeUpcomingSheets: Anstehende Übungsblätter
|
||||
HomeUpcomingExams: Bevorstehende Prüfungen
|
||||
|
||||
@ -558,7 +581,7 @@ RatingFilesUpdated: Korrigierte Dateien überschrieben
|
||||
RatingNotUnicode uexc@UnicodeException: Bewertungsdatei nicht in UTF-8 kodiert: #{tshow uexc}
|
||||
RatingMissingSeparator: Präambel der Bewertungsdatei konnte nicht identifziert werden
|
||||
RatingMultiple: Bewertungen enthält mehrere Punktzahlen für die gleiche Abgabe
|
||||
RatingInvalid parseErr@String: Bewertungspunktzahl konnte nicht als Zahl verstanden werden: #{parseErr}
|
||||
RatingInvalid parseErr@Text: Bewertungspunktzahl konnte nicht als Zahl verstanden werden: #{parseErr}
|
||||
RatingFileIsDirectory: Unerwarteter Fehler: Datei ist unerlaubterweise ein Verzeichnis
|
||||
RatingNegative: Bewertungspunkte dürfen nicht negativ sein
|
||||
RatingExceedsMax: Bewertung übersteigt die erlaubte Maximalpunktzahl
|
||||
@ -576,7 +599,7 @@ MultiSinkException name@Text error@Text: In Abgabe #{name} ist ein Fehler aufget
|
||||
|
||||
NoTableContent: Kein Tabelleninhalt
|
||||
NoUpcomingSheetDeadlines: Keine anstehenden Übungsblätter
|
||||
NoUpcomingExams: In den nächsten 14 Tagen gibt es keine Prüfung mit offener Registrierung in Ihren Kursen
|
||||
NoUpcomingExams difftime@Text: In den nächsten #{difftime} gibt es keine Prüfungen oder ablaufende Prüfungsanmeldungen in Ihren Kursen
|
||||
|
||||
AdminHeading: Administration
|
||||
AdminUserHeading: Benutzeradministration
|
||||
@ -592,7 +615,8 @@ TutorsFor n@Int: #{pluralDE n "Tutor" "Tutoren"}
|
||||
CorrectorsFor n@Int: #{pluralDE n "Korrektor" "Korrektoren"}
|
||||
ForSchools n@Int: für #{pluralDE n "Institut" "Institute"}
|
||||
UserListTitle: Komprehensive Benutzerliste
|
||||
AccessRightsSaved: Berechtigungsänderungen wurden gespeichert.
|
||||
AccessRightsSaved: Berechtigungen erfolgreich verändert
|
||||
AccessRightsNotChanged: Berechtigungen wurden nicht verändert
|
||||
|
||||
LecturersForN n@Int: #{pluralDE n "Dozent" "Dozenten"}
|
||||
|
||||
@ -602,7 +626,11 @@ DateFormat: Datumsformat
|
||||
TimeFormat: Uhrzeitformat
|
||||
DownloadFiles: Dateien automatisch herunterladen
|
||||
DownloadFilesTip: Wenn gesetzt werden Dateien von Abgaben und Übungsblättern automatisch als Download behandelt, ansonsten ist das Verhalten browserabhängig (es können z.B. PDFs im Browser geöffnet werden).
|
||||
WarningDays: Fristen-Vorschau
|
||||
WarningDaysTip: Wie viele Tage im Voraus sollen Fristen von Klausuren etc. auf Ihrer Startseite angezeigt werden?
|
||||
NotificationSettings: Erwünschte Benachrichtigungen
|
||||
UserSchools: Relevante Institute
|
||||
UserSchoolsTip: Sie erhalten nur institutweite Benachrichtigungen für Institute, die hier ausgewählt sind.
|
||||
FormNotifications: Benachrichtigungen
|
||||
FormBehaviour: Verhalten
|
||||
FormCosmetics: Oberfläche
|
||||
@ -637,7 +665,8 @@ CampusUserInvalidGivenName: Konnte anhand des Campus-Logins keinen Vornamen ermi
|
||||
CampusUserInvalidSurname: Konnte anhand des Campus-Logins keinen Nachname ermitteln
|
||||
CampusUserInvalidTitle: Konnte anhand des Campus-Logins keinen akademischen Titel ermitteln
|
||||
CampusUserInvalidMatriculation: Konnte anhand des Campus-Logins keine Matrikelnummer ermitteln
|
||||
CampusUserInvalidFeaturesOfStudy parseErr@String: Konnte anhand des Campus-Logins keine Matrikelnummer ermitteln: #{parseErr}
|
||||
CampusUserInvalidFeaturesOfStudy parseErr@Text: Konnte anhand des Campus-Logins keine Studiengänge ermitteln
|
||||
CampusUserInvalidAssociatedSchools parseErr@Text: Konnte anhand des Campus-Logins keine Institute ermitteln
|
||||
|
||||
CorrectorNormal: Normal
|
||||
CorrectorMissing: Abwesend
|
||||
@ -836,6 +865,8 @@ NotificationTriggerKindExamParticipant: Für Prüfungsteilnehmer
|
||||
NotificationTriggerKindCorrector: Für Korrektoren
|
||||
NotificationTriggerKindLecturer: Für Dozenten
|
||||
NotificationTriggerKindAdmin: Für Administratoren
|
||||
NotificationTriggerKindExamOffice: Für das Prüfungsamt
|
||||
NotificationTriggerKindEvaluation: Für Vorlesungsumfragen
|
||||
|
||||
CorrCreate: Abgaben erstellen
|
||||
UnknownPseudonymWord pseudonymWord@Text: Unbekanntes Pseudonym-Wort "#{pseudonymWord}"
|
||||
@ -933,6 +964,8 @@ ErrorCryptoIdMismatch: Verschlüsselte Id der Abgabe passte nicht zu anderen Dat
|
||||
|
||||
InvalidRoute: Konnte URL nicht interpretieren
|
||||
|
||||
MenuOpenCourses: Kurse mit offener Registrierung
|
||||
MenuOpenAllocations: Aktive Zentralanmeldungen
|
||||
MenuHome: Aktuell
|
||||
MenuInformation: Informationen
|
||||
MenuImpressum: Impressum
|
||||
@ -944,10 +977,12 @@ MenuHelp: Hilfe
|
||||
MenuProfile: Anpassen
|
||||
MenuLogin: Login
|
||||
MenuLogout: Logout
|
||||
MenuAllocationList: Zentralanmeldungen
|
||||
MenuCourseList: Kurse
|
||||
MenuCourseMembers: Kursteilnehmer
|
||||
MenuCourseAddMembers: Kursteilnehmer hinzufügen
|
||||
MenuCourseCommunication: Kursmitteilung
|
||||
MenuCourseApplications: Bewerbungen
|
||||
MenuTermShow: Semester
|
||||
MenuSubmissionDelete: Abgabe löschen
|
||||
MenuUsers: Benutzer
|
||||
@ -1000,6 +1035,10 @@ MenuExamEdit: Bearbeiten
|
||||
MenuExamUsers: Teilnehmer
|
||||
MenuExamAddMembers: Prüfungsteilnehmer hinzufügen
|
||||
MenuLecturerInvite: Dozenten hinzufügen
|
||||
MenuAllocationInfo: Hinweise zum Ablauf einer Zentralanmeldung
|
||||
MenuCourseApplicationsFiles: Dateien aller Bewerbungen
|
||||
MenuSchoolList: Institute
|
||||
MenuSchoolNew: Neues Institut anlegen
|
||||
|
||||
AuthPredsInfo: Um eigene Veranstaltungen aus Sicht der Teilnehmer anzusehen, können Veranstalter und Korrektoren hier die Prüfung ihrer erweiterten Berechtigungen temporär deaktivieren. Abgewählte Prädikate schlagen immer fehl. Abgewählte Prädikate werden also nicht geprüft um Zugriffe zu gewähren, welche andernfalls nicht erlaubt wären. Diese Einstellungen gelten nur temporär bis Ihre Sitzung abgelaufen ist, d.h. bis ihr Browser-Cookie abgelaufen ist. Durch Abwahl von Prädikaten kann man sich höchstens temporär aussperren.
|
||||
AuthPredsActive: Aktive Authorisierungsprädikate
|
||||
@ -1014,8 +1053,10 @@ AuthTagLecturer: Nutzer ist Dozent
|
||||
AuthTagCorrector: Nutzer ist Korrektor
|
||||
AuthTagTutor: Nutzer ist Tutor
|
||||
AuthTagTime: Zeitliche Einschränkungen sind erfüllt
|
||||
AuthTagStaffTime: Zeitliche Einschränkungen für Lehrbeteiligte sind erfüllt
|
||||
AuthTagAllocationTime: Zeitliche Einschränkungen durch Zentralanmeldung sind erfüllt
|
||||
AuthTagCourseRegistered: Nutzer ist Kursteilnehmer
|
||||
AuthTagAllocationRegistered: Nutzer nimmt an der Zentralanmeldung teil
|
||||
AuthTagTutorialRegistered: Nutzer ist Tutoriumsteilnehmer
|
||||
AuthTagExamRegistered: Nutzer ist Prüfungsteilnehmer
|
||||
AuthTagExamResult: Nutzer hat Prüfungsergebnisse
|
||||
@ -1353,11 +1394,12 @@ BtnCsvImport: CSV-Datei importieren
|
||||
BtnCsvImportConfirm: CSV-Import abschließen
|
||||
|
||||
CsvImportNotConfigured: CSV-Import nicht vorgesehen
|
||||
CsvImportConfirmationHeading: CSV-Import abschließen
|
||||
CsvImportConfirmationTip: Durch den CSV-Import würden die unten aufgeführten Änderungen vorgenommen. Bitte überprüfen Sie diese zunächst sorgfältig.
|
||||
CsvImportConfirmationHeading: CSV-Import Vorschau (noch keine Änderungen importiert)
|
||||
CsvImportConfirmationTip: Es wurden noch keine Änderungen übernommen! Durch den CSV-Import könnten die unten aufgeführten Änderungen vorgenommen werden. Wählen Sie jetzt die gewünschten Änderungen aus, bevor Sie den CSV-Import abschließen.
|
||||
CsvImportUnnecessary: Durch den CSV-Import würden keine Änderungen vorgenommen werden
|
||||
CsvImportSuccessful n@Int: CSV-Import erfolgreich, es #{pluralDE n "wurde eine Aktion" (mappend (mappend "wurden " (toMessage n)) " Aktionen")} durchgeführt
|
||||
CsvImportAborted: CSV-Import abgebrochen
|
||||
CsvImportExplanationLabel: Hinweise zum CSV-Import
|
||||
|
||||
Proportion c@Text of@Text prop@Rational: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%)
|
||||
|
||||
@ -1377,6 +1419,18 @@ CsvColumnExamUserExercisePasses: Anzahl von Übungsblättern, die der Teilnehmer
|
||||
CsvColumnExamUserExercisePassesMax: Maximale Anzahl von Übungsblättern, die der Teilnehmer bis zu seinem Prüfungstermin bestehen hätte können
|
||||
CsvColumnExamUserResult: Erreichte Prüfungsleistung; "passed", "failed", "no-show", "voided", oder eine Note ("1.0", "1.3", "1.7", ..., "4.0", "5.0")
|
||||
CsvColumnExamUserCourseNote: Notizen zum Teilnehmer
|
||||
CsvColumnApplicationsAllocation: Zentralanmeldung über die die Bewerbung eingegangen ist
|
||||
CsvColumnApplicationsApplication: Eindeutige Nummer der Bewerbung (zur Zuordnung im ZIP-Archiv aller Bewerbungsdateien)
|
||||
CsvColumnApplicationsName: Voller Name des Bewerbers
|
||||
CsvColumnApplicationsMatriculation: Matrikelnummer des Bewerbers
|
||||
CsvColumnApplicationsField: Studienfach, mit dem der Bewerber seine Bewerbung assoziiert hat
|
||||
CsvColumnApplicationsDegree: Abschluss, den der Bewerber im assoziierten Studienfach anstrebt
|
||||
CsvColumnApplicationsSemester: Fachsemester des Bewerbes im assoziierten Studienfach
|
||||
CsvColumnApplicationsText: Text-Bewerbung
|
||||
CsvColumnApplicationsHasFiles: Hat der Bewerber Dateien zu seiner Bewerbung eingereicht (siehe ZIP-Archiv aller Bewerbungsdateien)?
|
||||
CsvColumnApplicationsVeto: Bewerber mit Veto werden garantiert nicht dem Kurs zugeteilt; "veto" oder leer
|
||||
CsvColumnApplicationsRating: Bewertung der Bewerbung; "1.0", "1.3", "1.7", ..., "4.0", "5.0"
|
||||
CsvColumnApplicationsComment: Kommentar zur Bewerbung; je nach Kurs-Einstellungen entweder nur als Notiz für die Kursverwalter oder Feedback für den Bewerber
|
||||
|
||||
Action: Aktion
|
||||
|
||||
@ -1399,6 +1453,15 @@ ExamUserCsvExceptionNoMatchingUser: Kursteilnehmer konnte nicht eindeutig identi
|
||||
ExamUserCsvExceptionNoMatchingStudyFeatures: Das angegebene Studienfach konnte keinem Studienfach des Kursteilnehmers zugeordnet werden
|
||||
ExamUserCsvExceptionNoMatchingOccurrence: Raum/Termin konnte nicht eindeutig identifiziert werden
|
||||
|
||||
CourseApplicationsTableCsvSetField: Bewerbungs-assoziiertes Studienfach ändern
|
||||
CourseApplicationsTableCsvSetVeto: Veto setzen/entfernen
|
||||
CourseApplicationsTableCsvSetRating: Bewertung eintragen
|
||||
CourseApplicationsTableCsvSetComment: Bewertungskommentar eintragen
|
||||
|
||||
CourseApplicationsTableCsvExceptionNoMatchingUser: Bewerber konnte nicht eindeutig identifiziert werden
|
||||
CourseApplicationsTableCsvExceptionNoMatchingAllocation: Zentralanmeldung konnte nicht eindeutig identifiziert werden
|
||||
CourseApplicationsTableCsvExceptionNoMatchingStudyFeatures: Das angegebene Studienfach konnte keinem Studienfach des Kursteilnehmers zugeordnet werden
|
||||
|
||||
TableHeadingFilter: Filter
|
||||
TableHeadingCsvImport: CSV-Import
|
||||
TableHeadingCsvExport: CSV-Export
|
||||
@ -1434,14 +1497,96 @@ PasswordRepeatInvalid: Wiederholung stimmt nicht mit neuem Passwort überein
|
||||
UserPasswordHeadingFor: Passwort ändern für
|
||||
PasswordChangedSuccess: Passwort erfolgreich geändert
|
||||
|
||||
LecturerInviteSchool: Institut
|
||||
LecturerInviteField: Einzuladende EMail Addressen
|
||||
LecturerInviteHeading: Dozenten hinzufügen
|
||||
FunctionaryInviteFunction: Funktion
|
||||
FunctionaryInviteSchool: Institut
|
||||
FunctionaryInviteField: Einzuladende EMail Addressen
|
||||
FunctionaryInviteHeading: Institut-Funktionäre hinzufügen
|
||||
|
||||
LecturersInvited n@Int: #{n} #{pluralDE n "Dozent" "Dozenten"} per EMail eingeladen
|
||||
LecturersAdded n@Int: #{n} #{pluralDE n "Dozent" "Dozenten"} eingetragen
|
||||
FunctionariesInvited n@Int: #{n} #{pluralDE n "Funktionär" "Funktionäre"} per EMail eingeladen
|
||||
FunctionariesAdded n@Int: #{n} #{pluralDE n "Funktionär" "Funktionäre"} eingetragen
|
||||
|
||||
MailSubjectSchoolLecturerInvitation school@SchoolName: Einladung zum Dozent für „#{school}“
|
||||
MailSchoolLecturerInviteHeading school@SchoolName: Einladung zum Dozent für „#{school}“
|
||||
SchoolLecturerInviteExplanation: Sie wurden eingeladen, Dozent für ein Institut zu sein. Sie können, nachdem Sie die Einladung annehmen, eigenständig neue Kurse anlegen.
|
||||
SchoolLecturerInvitationAccepted school@SchoolName: Einladung zum Dozent für „#{school}“ angenommen
|
||||
MailSubjectSchoolFunctionInvitation school@SchoolName renderedFunction@Text: #{renderedFunction}-Einladung für „#{school}“
|
||||
MailSchoolFunctionInviteHeading school@SchoolName renderedFunction@Text: #{renderedFunction}-Einladung für „#{school}“
|
||||
SchoolFunctionInviteExplanation renderedFunction@Text: Sie wurden eingeladen, als #{renderedFunction} für ein Institut zu wirken. Sie erhalten, nachdem Sie die Einladung annehmen, erweiterte Rechte innerhalb des Instituts.
|
||||
SchoolFunctionInvitationAccepted school@SchoolName renderedFunction@Text: #{renderedFunction}-Einladung zum Dozent für „#{school}“ angenommen
|
||||
|
||||
AllocationActive: Aktiv
|
||||
AllocationName: Name
|
||||
AllocationTitle termText@Text ssh'@SchoolShorthand allocation@AllocationName: #{termText} - #{ssh'}: #{allocation}
|
||||
AllocationShortTitle termText@Text ssh'@SchoolShorthand ash@AllocationShorthand: #{termText} - #{ssh'} - #{ash}
|
||||
AllocationDescription: Beschreibung
|
||||
AllocationStaffRegisterFrom: Eintragung der Kurse ab
|
||||
AllocationStaffRegister: Eintragung der Kurse
|
||||
AllocationRegisterFrom: Bewerbung ab
|
||||
AllocationRegister: Bewerbung
|
||||
AllocationRegisterClosed: Die Zentralanmeldung ist aktuell geschlossen.
|
||||
AllocationRegisterOpensIn difftime@Text: Die Zentralanmeldung öffnet voraussichtlich in #{difftime}
|
||||
AllocationStaffAllocationFrom: Bewertung der Bewerbungen ab
|
||||
AllocationStaffAllocation: Bewertung der Bewerbungen
|
||||
AllocationProcess: Platzvergabe
|
||||
AllocationNoApplication: Keine Bewerbung
|
||||
AllocationPriority: Priorität
|
||||
AllocationPriorityTip: Kurse, denen Sie eine höhere Priorität zuteilen, werden bei der Platzvergabe präferiert.
|
||||
AllocationPriorityRelative: Die absoluten Prioritäts-Werte sind bedeutungslos, es wird nur jeweils betrachtet ob ein Kurs höhere Priorität hat als ein anderer.
|
||||
AllocationTotalCoursesNegative: Gewünschte Kursanzahl muss größer null sein
|
||||
AllocationTotalCourses: Gewünschte Anzahl von Kursen
|
||||
AllocationTotalCoursesTip: Sie werden im Laufe dieser Zentralanmeldung maximal so vielen Kursen zugeteilt, wie Sie hier angeben
|
||||
AllocationRegistered: Teilnahme an der Zentralanmeldung erfolgreich registriert
|
||||
AllocationRegistrationEdited: Einstellungen zur Teilnahme an der Zentralanmeldung erfolgreich angepasst
|
||||
BtnAllocationRegister: Teilnahme registrieren
|
||||
BtnAllocationRegistrationEdit: Teilnahme anpassen
|
||||
AllocationParticipation: Teilnahme an der Zentralanmeldung
|
||||
AllocationParticipationLoginFirst: Um an der Zentralanmeldung teilzunehmen, loggen Sie sich bitte zunächst ein.
|
||||
AllocationCourses: Kurse dieser Zentralanmeldung
|
||||
AllocationData: Organisatorisches
|
||||
AllocationCoursePriority i@Natural: #{i}. Wahl
|
||||
AllocationCourseNoApplication: Keine Bewerbung
|
||||
BtnAllocationApply: Bewerben
|
||||
BtnAllocationApplicationEdit: Bewerbung ersetzen
|
||||
BtnAllocationApplicationRetract: Bewerbung zurückziehen
|
||||
BtnAllocationApplicationRate: Bewerbung bewerten
|
||||
ApplicationPriority: Priorität
|
||||
ApplicationVeto: Veto
|
||||
ApplicationVetoTip: Bewerber mit Veto werden garantiert nicht dem Kurs zugeteilt
|
||||
ApplicationRatingPoints: Bewertung
|
||||
ApplicationRatingPointsTip: Bewerber mit 5.0 werden garantiert nicht dem Kurs zugeteilt
|
||||
ApplicationRatingComment: Kommentar
|
||||
ApplicationRatingCommentVisibleTip: Feedback an den Bewerbers
|
||||
ApplicationRatingCommentInvisibleTip: Dient zunächst nur als Notiz für Kursverwalter
|
||||
ApplicationRatingSection: Bewertung
|
||||
ApplicationRatingSectionSelfTip: Sie verfügen über hinreichende Authorisierung um sowohl die Bewerbung als auch ihre Bewertung zu editieren.
|
||||
|
||||
AllocationSchoolShort: Institut
|
||||
Allocation: Zentralanmeldung
|
||||
AllocationRegisterTo: Anmeldungen bis
|
||||
|
||||
AllocationListTitle: Zentralanmeldungen
|
||||
|
||||
CourseApplicationsListTitle: Bewerbungen
|
||||
CourseApplicationId: Bewerbungsnummer
|
||||
CourseApplicationRatingPoints: Bewertung
|
||||
CourseApplicationVeto: Veto
|
||||
CourseApplicationNoVeto: Kein Veto
|
||||
CourseApplicationNoRatingPoints: Keine Bewertung
|
||||
CourseApplicationNoRatingComment: Kein Kommentar
|
||||
|
||||
UserDisplayName: Voller Name
|
||||
UserMatriculation: Matrikelnummer
|
||||
|
||||
SchoolShort: Kürzel
|
||||
SchoolName: Name
|
||||
SchoolLdapOrganisations: Assoziierte LDAP-Fragmente
|
||||
SchoolLdapOrganisationsTip: Beim Login via LDAP werden dem Nutzer alle Institute zugeordnet deren assoziierte LDAP-Fragmente im Eintrag des Nutzer gefunden werden
|
||||
|
||||
SchoolUpdated ssh@SchoolId: #{ssh} erfolgreich angepasst
|
||||
SchoolTitle ssh@SchoolId: Institut „#{ssh}“
|
||||
TitleSchoolNew: Neues Institut anlegen
|
||||
SchoolCreated ssh@SchoolId: #{ssh} erfolgreich angelegt
|
||||
SchoolExists ssh@SchoolId: Institut „#{ssh}“ existiert bereits
|
||||
|
||||
SchoolAdmin: Admin
|
||||
SchoolLecturer: Dozent
|
||||
SchoolEvaluation: Kursumfragenverwaltung
|
||||
SchoolExamOffice: Prüfungsamt
|
||||
|
||||
ApplicationEditTip: Während des Bewerbungszeitraums können eigene Bewerbungen beliebig angepasst und auch wieder zurückgezogen werden.
|
||||
@ -1,12 +1,10 @@
|
||||
Allocation -- attributes with prefix staff- affect lecturers only, but are invisble to students
|
||||
name (CI Text)
|
||||
shorthand (CI Text) -- practical shorthand
|
||||
term TermId
|
||||
school SchoolId -- school that manages this central allocation, not necessarily school of courses
|
||||
shorthand AllocationShorthand -- practical shorthand
|
||||
name AllocationName
|
||||
description Html Maybe -- description for prospective students
|
||||
staffDescription Html Maybe -- description seen by prospective lecturers only
|
||||
linkExternal Text Maybe -- arbitrary user-defined url for external course page
|
||||
capacity Int Maybe -- number of allowed enrolements, if restricte
|
||||
staffRegisterFrom UTCTime Maybe -- lectureres may register courses
|
||||
staffRegisterTo UTCTime Maybe -- course registration stops
|
||||
-- staffDeregisterUntil not needed: staff may make arbitrary changes until staffRegisterTo, always frozen afterwards
|
||||
@ -17,7 +15,6 @@ Allocation -- attributes with prefix staff- affect lecturers only, but are invis
|
||||
registerFrom UTCTime Maybe -- student applications allowed from a given day onwwards or prohibited
|
||||
registerTo UTCTime Maybe -- student applications may be prohibited from a given date onwards
|
||||
-- deregisterUntil not needed: students may withdraw applicants until registerTo, but never after. Also see overrideDeregister
|
||||
registerSecret Text Maybe -- student application maybe protected by a simple common passphrase
|
||||
-- overrides
|
||||
registerByStaffFrom UTCTime Maybe -- lecturers may directly enrol/disenrol students after a given date or prohibited
|
||||
registerByStaffTo UTCTime Maybe
|
||||
@ -26,6 +23,7 @@ Allocation -- attributes with prefix staff- affect lecturers only, but are invis
|
||||
-- overrideVisible not needed, since courses are always visible
|
||||
TermSchoolAllocationShort term school shorthand -- shorthand must be unique within school and semester
|
||||
TermSchoolAllocationName term school name -- name must be unique within school and semester
|
||||
deriving Show Eq Ord Generic
|
||||
|
||||
AllocationCourse
|
||||
allocation AllocationId
|
||||
@ -41,7 +39,6 @@ AllocationUser
|
||||
|
||||
AllocationDeregister -- self-inflicted user-deregistrations from an allocated course
|
||||
user UserId
|
||||
allocation AllocationId Maybe
|
||||
course CourseId Maybe
|
||||
time UTCTime
|
||||
reason Text Maybe -- if this deregistration was done by proxy (e.g. the lecturer pressed the button)
|
||||
|
||||
@ -76,11 +76,13 @@ CourseApplication
|
||||
user UserId
|
||||
field StudyFeaturesId Maybe -- associated degree course, user-defined; required for communicating grades
|
||||
text Text Maybe -- free text entered by user
|
||||
ratingVeto Bool default=false
|
||||
ratingPoints ExamGrade Maybe
|
||||
ratingComment Text Maybe
|
||||
allocation AllocationId Maybe
|
||||
allocationPriority Natural Maybe
|
||||
time UTCTime default=now()
|
||||
ratingTime UTCTime Maybe
|
||||
CourseApplicationFile
|
||||
application CourseApplicationId
|
||||
file FileId
|
||||
|
||||
@ -2,4 +2,5 @@ Invitation
|
||||
email UserEmail
|
||||
for Value
|
||||
data Value
|
||||
expiresAt UTCTime Maybe
|
||||
UniqueInvitation email for
|
||||
@ -6,4 +6,11 @@ School json
|
||||
UniqueSchool name
|
||||
UniqueSchoolShorthand shorthand -- required for Normalisation of CI Text
|
||||
Primary shorthand -- newtype Key School = SchoolKey { unSchoolKey :: SchoolShorthand }
|
||||
deriving Eq Show Generic
|
||||
deriving Ord Eq Show Generic
|
||||
SchoolLdap
|
||||
school SchoolId Maybe
|
||||
orgUnit (CI Text)
|
||||
UniqueOrgUnit orgUnit
|
||||
SchoolTerms
|
||||
school SchoolId
|
||||
terms StudyTermsId
|
||||
45
models/users
45
models/users
@ -8,14 +8,16 @@
|
||||
-- Each table will also have an column storing a unique numeric row key, unless there is a row Primary columnname
|
||||
--
|
||||
User json -- Each Uni2work user has a corresponding row in this table; created upon first login.
|
||||
surname UserSurname -- Display user names always through 'nameWidget displayName surname'
|
||||
displayName UserDisplayName -- we only show LDAP-DisplayName, and highlight LDAP-Surname within (appended if not contained)
|
||||
email (CI Text) -- Case-insensitive eMail address
|
||||
ident (CI Text) -- Case-insensitive user-identifier
|
||||
authentication AuthenticationMode -- 'AuthLDAP' or ('AuthPWHash'+password-hash)
|
||||
lastAuthentication UTCTime Maybe -- last login date
|
||||
tokensIssuedAfter UTCTime Maybe -- do not accept bearer tokens issued before this time (accept all tokens if null)
|
||||
matrikelnummer Text Maybe -- optional immatriculation-string; usually a number, but not always (e.g. lecturers, pupils, guests,...)
|
||||
email (CI Text) -- Case-insensitive eMail address
|
||||
displayName Text -- we only show LDAP-DisplayName, and highlight LDAP-Surname within (appended if not contained)
|
||||
surname Text -- Display user names always through 'nameWidget displayName surname'
|
||||
created UTCTime default=now()
|
||||
lastLdapSynchronisation UTCTime Maybe
|
||||
tokensIssuedAfter UTCTime Maybe -- do not accept bearer tokens issued before this time (accept all tokens if null)
|
||||
matrikelnummer UserMatriculation Maybe -- optional immatriculation-string; usually a number, but not always (e.g. lecturers, pupils, guests,...)
|
||||
firstName Text -- For export in tables, pre-split firstName from displayName
|
||||
title Text Maybe -- For upcoming name customisation
|
||||
maxFavourites Int default=12 -- max number of rows with this userId in table "CourseFavourite"; for convenience links; user-defined
|
||||
@ -23,20 +25,27 @@ User json -- Each Uni2work user has a corresponding row in this table; create
|
||||
dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'" -- preferred Date+Time display format for user; user-defined
|
||||
dateFormat DateTimeFormat "default='%d.%m.%Y'" -- preferred Date-only display format for user; user-defined
|
||||
timeFormat DateTimeFormat "default='%R'" -- preferred Time-only display format for user; user-defined
|
||||
downloadFiles Bool default=false -- Should files be opened in browser or downloaded? (users often oblivious that their browser has a setting for this)
|
||||
downloadFiles Bool default=false -- Should files be opened in browser or downloaded? (users often oblivious that their browser has a setting for this)
|
||||
mailLanguages MailLanguages "default='[]'::jsonb" -- Preferred language for eMail; i18n not yet implemented; user-defined
|
||||
notificationSettings NotificationSettings -- Bit-array for which events email notifications are requested by user; user-defined
|
||||
UniqueAuthentication ident -- Column 'ident' can be used as a row-key in this table
|
||||
UniqueEmail email -- Column 'email' can be used as a row-key in this table
|
||||
deriving Show Eq Generic -- Haskell-specific settings for runtime-value representing a row in memory
|
||||
UserAdmin -- Each row in this table grants school-specific administrator-rights to a specific user
|
||||
user UserId
|
||||
school SchoolId
|
||||
UniqueUserAdmin user school -- combination of user+school must be unique, i.e. no duplicate rows
|
||||
UserLecturer -- Each row in this table grants school-specific lecturer-rights to a specific user
|
||||
user UserId
|
||||
school SchoolId
|
||||
UniqueSchoolLecturer user school -- combination of user+school must be unique, i.e. no duplicate rows
|
||||
notificationSettings NotificationSettings -- Bit-array for which events email notifications are requested by user; user-defined
|
||||
warningDays NominalDiffTime default=1209600 -- timedistance to pending deadlines for homepage infos
|
||||
UniqueAuthentication ident -- Column 'ident' can be used as a row-key in this table
|
||||
UniqueEmail email -- Column 'email' can be used as a row-key in this table
|
||||
deriving Show Eq Ord Generic -- Haskell-specific settings for runtime-value representing a row in memory
|
||||
UserFunction -- Administratively assigned functions (lecturer, admin, evaluation, ...)
|
||||
user UserId
|
||||
school SchoolId
|
||||
function SchoolFunction
|
||||
UniqueUserFunction user school function
|
||||
UserExamOffice
|
||||
user UserId
|
||||
field StudyTermsId
|
||||
UniqueUserExamOffice user field
|
||||
UserSchool -- Managed by users themselves, encodes "schools of interest"
|
||||
user UserId
|
||||
school SchoolId
|
||||
isOptOut Bool -- true if this a marker, that the user manually deleted this entry; it should not be recreated automatically
|
||||
UniqueUserSchool user school
|
||||
StudyFeatures -- multiple entries possible for students pursuing several degrees at once, usually created upon LDAP login
|
||||
user UserId
|
||||
degree StudyDegreeId -- Abschluss, i.e. Master, Bachelor, etc.
|
||||
|
||||
1825
package-lock.json
generated
1825
package-lock.json
generated
File diff suppressed because it is too large
Load Diff
37
package.json
37
package.json
@ -1,6 +1,6 @@
|
||||
{
|
||||
"name": "uni2work",
|
||||
"version": "5.0.2",
|
||||
"version": "5.5.0",
|
||||
"description": "",
|
||||
"keywords": [],
|
||||
"author": "",
|
||||
@ -49,16 +49,17 @@
|
||||
"defaults"
|
||||
],
|
||||
"devDependencies": {
|
||||
"@babel/cli": "^7.4.4",
|
||||
"@babel/core": "^7.4.5",
|
||||
"@babel/plugin-proposal-class-properties": "^7.4.4",
|
||||
"@babel/cli": "^7.5.5",
|
||||
"@babel/core": "^7.5.5",
|
||||
"@babel/plugin-proposal-class-properties": "^7.5.5",
|
||||
"@babel/plugin-proposal-decorators": "^7.4.4",
|
||||
"@babel/preset-env": "^7.4.5",
|
||||
"@babel/plugin-transform-runtime": "^7.5.5",
|
||||
"@babel/preset-env": "^7.5.5",
|
||||
"@commitlint/cli": "^8.1.0",
|
||||
"@commitlint/config-conventional": "^8.0.0",
|
||||
"autoprefixer": "^9.6.0",
|
||||
"@commitlint/config-conventional": "^8.1.0",
|
||||
"autoprefixer": "^9.6.1",
|
||||
"babel-core": "^6.26.3",
|
||||
"babel-eslint": "^10.0.1",
|
||||
"babel-eslint": "^10.0.3",
|
||||
"babel-loader": "^8.0.6",
|
||||
"babel-plugin-syntax-dynamic-import": "^6.18.0",
|
||||
"babel-plugin-transform-decorators-legacy": "^1.3.5",
|
||||
@ -66,9 +67,9 @@
|
||||
"css-loader": "^2.1.1",
|
||||
"eslint": "^5.16.0",
|
||||
"extract-text-webpack-plugin": "^4.0.0-beta.0",
|
||||
"husky": "^2.4.1",
|
||||
"husky": "^2.7.0",
|
||||
"jasmine-core": "^3.4.0",
|
||||
"karma": "^4.1.0",
|
||||
"karma": "^4.3.0",
|
||||
"karma-chrome-launcher": "^2.2.0",
|
||||
"karma-cli": "^2.0.0",
|
||||
"karma-jasmine": "^2.0.1",
|
||||
@ -81,15 +82,19 @@
|
||||
"npm-run-all": "^4.1.5",
|
||||
"null-loader": "^2.0.0",
|
||||
"postcss-loader": "^3.0.0",
|
||||
"sass-loader": "^7.1.0",
|
||||
"sass-loader": "^7.3.1",
|
||||
"standard-version": "^6.0.1",
|
||||
"style-loader": "^0.23.1",
|
||||
"uglifyjs-webpack-plugin": "^2.1.3",
|
||||
"webpack": "^4.34.0",
|
||||
"webpack-cli": "^3.3.4"
|
||||
"uglifyjs-webpack-plugin": "^2.2.0",
|
||||
"webpack": "^4.39.3",
|
||||
"webpack-cli": "^3.3.7"
|
||||
},
|
||||
"dependencies": {
|
||||
"flatpickr": "^4.5.7",
|
||||
"npm": "^6.10.1"
|
||||
"@babel/runtime": "^7.5.5",
|
||||
"moment": "^2.24.0",
|
||||
"npm": "^6.11.2",
|
||||
"tail.datetime": "git+https://github.com/uni2work/tail.DateTime.git#master",
|
||||
"core-js": "^3.2.1",
|
||||
"whatwg-fetch": "^3.0.0"
|
||||
}
|
||||
}
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
name: uniworx
|
||||
version: 5.0.2
|
||||
version: 5.5.0
|
||||
|
||||
dependencies:
|
||||
# Due to a bug in GHC 8.0.1, we block its usage
|
||||
@ -194,7 +194,7 @@ ghc-options:
|
||||
- -fno-warn-unrecognised-pragmas
|
||||
- -fno-warn-partial-type-signatures
|
||||
- -fno-max-relevant-binds
|
||||
- -j3
|
||||
- -j
|
||||
|
||||
when:
|
||||
- condition: flag(pedantic)
|
||||
|
||||
32
routes
32
routes
@ -49,8 +49,8 @@
|
||||
/users/#CryptoUUIDUser/hijack AdminHijackUserR POST !adminANDno-escalation
|
||||
/users/#CryptoUUIDUser/notifications UserNotificationR GET POST !self
|
||||
/users/#CryptoUUIDUser/password UserPasswordR GET POST !selfANDis-pw-hash
|
||||
!/users/lecturer-invite/new AdminNewLecturerInviteR GET POST
|
||||
!/users/lecturer-invite AdminLecturerInviteR GET POST
|
||||
!/users/functionary-invite/new AdminNewFunctionaryInviteR GET POST
|
||||
!/users/functionary-invite AdminFunctionaryInviteR GET POST
|
||||
/admin AdminR GET
|
||||
/admin/features AdminFeaturesR GET POST
|
||||
/admin/test AdminTestR GET POST
|
||||
@ -61,6 +61,7 @@
|
||||
/info InfoR GET !free
|
||||
/info/lecturer InfoLecturerR GET !lecturer
|
||||
/info/data DataProtR GET !free
|
||||
/info/allocation InfoAllocationR GET !free
|
||||
/impressum ImpressumR GET !free
|
||||
/version VersionR GET !free
|
||||
|
||||
@ -77,8 +78,16 @@
|
||||
!/term/#TermId TermCourseListR GET !free
|
||||
!/term/#TermId/#SchoolId TermSchoolCourseListR GET !free
|
||||
|
||||
/school SchoolListR GET !development
|
||||
/school/#SchoolId SchoolShowR GET !development
|
||||
/school SchoolListR GET
|
||||
!/school/new SchoolNewR GET POST
|
||||
/school/#SchoolId SchoolR:
|
||||
/ SchoolEditR GET POST
|
||||
|
||||
/allocation/ AllocationListR GET !free
|
||||
/allocation/#TermId/#SchoolId/#AllocationShorthand AllocationR:
|
||||
/ AShowR GET !free
|
||||
/register ARegisterR POST !time
|
||||
/course/#CryptoUUIDCourse/apply AApplyR POST !timeANDallocation-registered
|
||||
|
||||
|
||||
-- For Pattern Synonyms see Foundation
|
||||
@ -100,11 +109,11 @@
|
||||
/notes CNotesR GET POST !corrector -- THIS route is used to check for overall course corrector access!
|
||||
/subs CCorrectionsR GET POST
|
||||
/subs/assigned CAssignR GET POST
|
||||
/ex SheetListR GET !course-registered !materials !corrector
|
||||
/ex/new SheetNewR GET POST
|
||||
/ex/current SheetCurrentR GET !course-registered !materials !corrector
|
||||
/ex/unassigned SheetOldUnassignedR GET
|
||||
/ex/#SheetName SheetR:
|
||||
/sheet SheetListR GET !course-registered !materials !corrector
|
||||
/sheet/new SheetNewR GET POST
|
||||
/sheet/current SheetCurrentR GET !course-registered !materials !corrector
|
||||
/sheet/unassigned SheetOldUnassignedR GET
|
||||
/sheet/#SheetName SheetR:
|
||||
/show SShowR GET !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor
|
||||
/show/download SArchiveR GET !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor
|
||||
/edit SEditR GET POST
|
||||
@ -154,8 +163,11 @@
|
||||
/users/new EAddUserR GET POST
|
||||
/users/invite EInviteR GET POST
|
||||
/register ERegisterR POST !timeANDcourse-registeredAND¬exam-registered !timeANDexam-registeredAND¬exam-result
|
||||
/apps CApplicationsR GET POST
|
||||
!/apps/files CAppsFilesR GET
|
||||
/apps/#CryptoFileNameCourseApplication CourseApplicationR:
|
||||
/files CAFilesR GET !self !lecturerANDtime
|
||||
/ CAEditR GET POST !timeANDself !lecturerANDstaff-time !selfANDread
|
||||
/files CAFilesR GET !self !lecturerANDstaff-time
|
||||
|
||||
/subs CorrectionsR GET POST !corrector !lecturer
|
||||
/subs/upload CorrectionsUploadR GET POST !corrector !lecturer
|
||||
|
||||
@ -64,10 +64,6 @@ import qualified Yesod.Core.Types as Yesod (Logger(..))
|
||||
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import Data.Proxy
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
|
||||
import System.Exit
|
||||
@ -112,6 +108,7 @@ import Handler.CryptoIDDispatch
|
||||
import Handler.SystemMessage
|
||||
import Handler.Health
|
||||
import Handler.Exam
|
||||
import Handler.Allocation
|
||||
|
||||
|
||||
-- This line actually creates our YesodDispatch instance. It is the second half
|
||||
|
||||
@ -2,15 +2,15 @@ module Auth.LDAP
|
||||
( apLdap
|
||||
, campusLogin
|
||||
, CampusUserException(..)
|
||||
, campusUser
|
||||
, campusUser, campusUser'
|
||||
, CampusMessage(..)
|
||||
, ldapUserPrincipalName, ldapUserEmail, ldapUserDisplayName
|
||||
, ldapUserMatriculation, ldapUserFirstName, ldapUserSurname
|
||||
, ldapUserTitle, ldapUserStudyFeatures, ldapUserFieldName
|
||||
, ldapUserSchoolAssociation
|
||||
) where
|
||||
|
||||
import Import.NoFoundation hiding (userEmail, userDisplayName)
|
||||
import Control.Lens
|
||||
import Import.NoFoundation
|
||||
import Network.Connection
|
||||
|
||||
import Data.CaseInsensitive (CI)
|
||||
@ -59,16 +59,17 @@ findUser LdapConf{..} ldap ident retAttrs = fromMaybe [] <$> findM (assertM (not
|
||||
, Ldap.derefAliases Ldap.DerefAlways
|
||||
]
|
||||
|
||||
ldapUserPrincipalName, ldapUserEmail, ldapUserDisplayName, ldapUserMatriculation, ldapUserFirstName, ldapUserSurname, ldapUserTitle, ldapUserStudyFeatures, ldapUserFieldName :: Ldap.Attr
|
||||
ldapUserPrincipalName = Ldap.Attr "userPrincipalName"
|
||||
ldapUserEmail = Ldap.Attr "mail"
|
||||
ldapUserDisplayName = Ldap.Attr "displayName"
|
||||
ldapUserMatriculation = Ldap.Attr "LMU-Stud-Matrikelnummer"
|
||||
ldapUserFirstName = Ldap.Attr "givenName"
|
||||
ldapUserSurname = Ldap.Attr "sn"
|
||||
ldapUserTitle = Ldap.Attr "title"
|
||||
ldapUserStudyFeatures = Ldap.Attr "dfnEduPersonFeaturesOfStudy"
|
||||
ldapUserFieldName = Ldap.Attr "dfnEduPersonFieldOfStudyString"
|
||||
ldapUserPrincipalName, ldapUserEmail, ldapUserDisplayName, ldapUserMatriculation, ldapUserFirstName, ldapUserSurname, ldapUserTitle, ldapUserStudyFeatures, ldapUserFieldName, ldapUserSchoolAssociation :: Ldap.Attr
|
||||
ldapUserPrincipalName = Ldap.Attr "userPrincipalName"
|
||||
ldapUserEmail = Ldap.Attr "mail"
|
||||
ldapUserDisplayName = Ldap.Attr "displayName"
|
||||
ldapUserMatriculation = Ldap.Attr "LMU-Stud-Matrikelnummer"
|
||||
ldapUserFirstName = Ldap.Attr "givenName"
|
||||
ldapUserSurname = Ldap.Attr "sn"
|
||||
ldapUserTitle = Ldap.Attr "title"
|
||||
ldapUserStudyFeatures = Ldap.Attr "dfnEduPersonFeaturesOfStudy"
|
||||
ldapUserFieldName = Ldap.Attr "dfnEduPersonFieldOfStudyString"
|
||||
ldapUserSchoolAssociation = Ldap.Attr "LMU-IFI-eduPersonOrgUnitDNString"
|
||||
|
||||
|
||||
data CampusUserException = CampusUserLdapError LdapPoolError
|
||||
@ -81,6 +82,8 @@ data CampusUserException = CampusUserLdapError LdapPoolError
|
||||
|
||||
instance Exception CampusUserException
|
||||
|
||||
makePrisms ''CampusUserException
|
||||
|
||||
campusUser :: (MonadBaseControl IO m, MonadThrow m, MonadIO m) => LdapConf -> LdapPool -> Creds site -> m (Ldap.AttrList [])
|
||||
campusUser conf@LdapConf{..} pool Creds{..} = liftIO . (`catches` errHandlers) $ either (throwM . CampusUserLdapError) return <=< withLdap pool $ \ldap -> do
|
||||
Ldap.bind ldap ldapDn ldapPassword
|
||||
@ -106,6 +109,10 @@ campusUser conf@LdapConf{..} pool Creds{..} = liftIO . (`catches` errHandlers) $
|
||||
, Exc.Handler $ \(HostCannotConnect host excs) -> throwM $ CampusUserHostCannotConnect host excs
|
||||
]
|
||||
|
||||
campusUser' :: (MonadBaseControl IO m, MonadCatch m, MonadIO m) => LdapConf -> LdapPool -> User -> m (Maybe (Ldap.AttrList []))
|
||||
campusUser' conf pool User{userIdent}
|
||||
= runMaybeT . catchIfMaybeT (is _CampusUserNoResult) $ campusUser conf pool (Creds apLdap (CI.original userIdent) [])
|
||||
|
||||
|
||||
campusForm :: ( RenderMessage site FormMessage
|
||||
, RenderMessage site CampusMessage
|
||||
|
||||
19
src/Colonnade/Instances.hs
Normal file
19
src/Colonnade/Instances.hs
Normal file
@ -0,0 +1,19 @@
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module Colonnade.Instances
|
||||
(
|
||||
) where
|
||||
|
||||
import ClassyPrelude
|
||||
|
||||
import Control.Lens.Indexed (FunctorWithIndex(imap))
|
||||
|
||||
import Colonnade.Encode (Colonnade(..), OneColonnade(..))
|
||||
|
||||
instance Functor h => FunctorWithIndex (Maybe a) (Colonnade h a) where
|
||||
imap f (Colonnade ones) = Colonnade $ dimapColonnade' <$> ones
|
||||
where
|
||||
dimapColonnade' OneColonnade{..} = OneColonnade
|
||||
{ oneColonnadeEncode = \x -> f (Just x) $ oneColonnadeEncode x
|
||||
, oneColonnadeHead = f Nothing <$> oneColonnadeHead
|
||||
}
|
||||
22
src/Crypto/Hash/Instances.hs
Normal file
22
src/Crypto/Hash/Instances.hs
Normal file
@ -0,0 +1,22 @@
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module Crypto.Hash.Instances
|
||||
() where
|
||||
|
||||
import ClassyPrelude
|
||||
|
||||
import Crypto.Hash
|
||||
|
||||
import Database.Persist
|
||||
import Database.Persist.Sql
|
||||
|
||||
import Data.ByteArray (convert)
|
||||
|
||||
|
||||
instance HashAlgorithm hash => PersistField (Digest hash) where
|
||||
toPersistValue = PersistByteString . convert
|
||||
fromPersistValue (PersistByteString bs) = maybe (Left "Could not convert Digest from ByteString") Right $ digestFromByteString bs
|
||||
fromPersistValue _ = Left "Digest values must be converted from PersistByteString"
|
||||
|
||||
instance HashAlgorithm hash => PersistFieldSql (Digest hash) where
|
||||
sqlType _ = SqlBlob
|
||||
@ -49,6 +49,7 @@ decCryptoIDs [ ''SubmissionId
|
||||
, ''ExamPartId
|
||||
, ''AllocationId
|
||||
, ''CourseApplicationId
|
||||
, ''CourseId
|
||||
]
|
||||
|
||||
-- CryptoIDNamespace (CI FilePath) SubmissionId ~ "Submission"
|
||||
|
||||
28
src/Data/Bool/Instances.hs
Normal file
28
src/Data/Bool/Instances.hs
Normal file
@ -0,0 +1,28 @@
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module Data.Bool.Instances
|
||||
() where
|
||||
|
||||
import ClassyPrelude
|
||||
|
||||
import qualified Data.Csv as Csv
|
||||
import Data.CaseInsensitive (CI)
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import Data.CaseInsensitive.Instances ()
|
||||
|
||||
import qualified Data.Text as Text
|
||||
|
||||
|
||||
instance Csv.ToField Bool where
|
||||
toField True = "t"
|
||||
toField False = "f"
|
||||
|
||||
instance Csv.FromField Bool where
|
||||
parseField f = do
|
||||
(CI.map Text.strip -> t :: CI Text) <- Csv.parseField f
|
||||
(True <$ guard (isTrue t)) <|> (False <$ guard (isFalse t)) <|> fail "Could not decode Bool"
|
||||
where
|
||||
isTrue = flip elem
|
||||
[ "yes", "y", "ja", "j", "wahr", "w", "true", "t", "1" ]
|
||||
isFalse = flip elem
|
||||
[ "no", "n", "nein", "falsch", "f", "false", "0" ]
|
||||
@ -13,8 +13,35 @@ import ClassyPrelude
|
||||
import Data.CaseInsensitive (CI)
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
instance {-# OVERLAPS #-} ToMarkup s => ToMarkup (CID.CryptoID c (CI s)) where
|
||||
toMarkup = toMarkup . CI.foldedCase . CID.ciphertext
|
||||
import Web.PathPieces
|
||||
import Data.Aeson (ToJSON(..), ToJSONKey(..), ToJSONKeyFunction(..))
|
||||
|
||||
import qualified Data.Csv as Csv
|
||||
|
||||
|
||||
instance ToMarkup s => ToMarkup (CID.CryptoID c s) where
|
||||
toMarkup = toMarkup . CID.ciphertext
|
||||
|
||||
instance {-# OVERLAPS #-} ToMarkup s => ToMarkup (CID.CryptoID c (CI s)) where
|
||||
toMarkup = toMarkup . CI.foldedCase . CID.ciphertext
|
||||
|
||||
instance {-# OVERLAPS #-} ToJSON s => ToJSON (CID.CryptoID c (CI s)) where
|
||||
toJSON = toJSON . CI.foldedCase . CID.ciphertext
|
||||
|
||||
instance {-# OVERLAPS #-} (ToJSON s, ToJSONKey s) => ToJSONKey (CID.CryptoID c (CI s)) where
|
||||
toJSONKey = case toJSONKey of
|
||||
ToJSONKeyText toT toE -> ToJSONKeyText (toT . CI.foldedCase . CID.ciphertext) (toE . CI.foldedCase . CID.ciphertext)
|
||||
ToJSONKeyValue toV toE -> ToJSONKeyValue (toV . CI.foldedCase . CID.ciphertext) (toE . CI.foldedCase . CID.ciphertext)
|
||||
|
||||
instance {-# OVERLAPS #-} (PathPiece s, CI.FoldCase s) => PathPiece (CID.CryptoID c (CI s)) where
|
||||
toPathPiece = toPathPiece . CI.foldedCase . CID.ciphertext
|
||||
fromPathPiece = fmap (CID.CryptoID . CI.mk) . fromPathPiece
|
||||
|
||||
instance Csv.FromField s => Csv.FromField (CID.CryptoID c s) where
|
||||
parseField = fmap CID.CryptoID . Csv.parseField
|
||||
|
||||
instance Csv.ToField s => Csv.ToField (CID.CryptoID c s) where
|
||||
toField = Csv.toField . CID.ciphertext
|
||||
|
||||
instance {-# OVERLAPS #-} (Csv.ToField s, CI.FoldCase s) => Csv.ToField (CID.CryptoID c (CI s)) where
|
||||
toField = Csv.toField . CI.foldedCase . CID.ciphertext
|
||||
|
||||
@ -6,17 +6,27 @@ module Data.Time.Clock.Instances
|
||||
|
||||
import ClassyPrelude
|
||||
|
||||
import Data.Time.Clock
|
||||
import Database.Persist.Sql
|
||||
|
||||
import Data.Proxy
|
||||
|
||||
import Data.Binary (Binary)
|
||||
import qualified Data.Binary as Binary
|
||||
|
||||
import Data.Time.Clock
|
||||
import Data.Time.Calendar.Instances ()
|
||||
|
||||
|
||||
instance Hashable DiffTime where
|
||||
hashWithSalt s = hashWithSalt s . toRational
|
||||
|
||||
instance PersistField NominalDiffTime where
|
||||
toPersistValue = toPersistValue . toRational
|
||||
fromPersistValue = fmap fromRational . fromPersistValue
|
||||
|
||||
instance PersistFieldSql NominalDiffTime where
|
||||
sqlType _ = sqlType (Proxy @Rational)
|
||||
|
||||
|
||||
deriving instance Generic UTCTime
|
||||
instance Hashable UTCTime
|
||||
@ -25,5 +35,5 @@ instance Hashable UTCTime
|
||||
instance Binary DiffTime where
|
||||
get = fromRational <$> Binary.get
|
||||
put = Binary.put . toRational
|
||||
|
||||
|
||||
instance Binary UTCTime
|
||||
|
||||
12
src/Data/Void/Instances.hs
Normal file
12
src/Data/Void/Instances.hs
Normal file
@ -0,0 +1,12 @@
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
module Data.Void.Instances
|
||||
(
|
||||
) where
|
||||
|
||||
import ClassyPrelude.Yesod
|
||||
import Data.Void
|
||||
|
||||
instance ToContent Void where
|
||||
toContent = absurd
|
||||
instance ToTypedContent Void where
|
||||
toTypedContent = absurd
|
||||
@ -15,10 +15,14 @@ module Database.Esqueleto.Utils
|
||||
, orderByOrd, orderByEnum
|
||||
, lower, ciEq
|
||||
, selectExists
|
||||
, SqlHashable
|
||||
, sha256
|
||||
, maybe
|
||||
, SqlProject(..)
|
||||
) where
|
||||
|
||||
|
||||
import ClassyPrelude.Yesod hiding (isInfixOf, any, all, or, and, isJust)
|
||||
import ClassyPrelude.Yesod hiding (isInfixOf, any, all, or, and, isJust, maybe)
|
||||
import Data.Universe
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.List as List
|
||||
@ -27,6 +31,11 @@ import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Internal.Sql as E
|
||||
import Database.Esqueleto.Utils.TH
|
||||
|
||||
import qualified Data.Text.Lazy as Lazy (Text)
|
||||
import qualified Data.ByteString.Lazy as Lazy (ByteString)
|
||||
|
||||
import Crypto.Hash (Digest, SHA256)
|
||||
|
||||
{-# ANN any ("HLint: ignore Use any" :: String) #-}
|
||||
{-# ANN all ("HLint: ignore Use all" :: String) #-}
|
||||
|
||||
@ -55,6 +64,8 @@ false = E.val False
|
||||
isJust :: (E.Esqueleto query expr backend, PersistField typ) => expr (E.Value (Maybe typ)) -> expr (E.Value Bool)
|
||||
isJust = E.not_ . E.isNothing
|
||||
|
||||
infix 4 `isInfixOf`, `hasInfix`
|
||||
|
||||
-- | Check if the first string is contained in the text derived from the second argument
|
||||
isInfixOf :: ( E.Esqueleto query expr backend
|
||||
, E.SqlString s1
|
||||
@ -153,21 +164,17 @@ mkExistsFilter query row criterias
|
||||
| otherwise = any (E.exists . query row) $ Set.toList criterias
|
||||
|
||||
-- | Combine several filters, using logical or
|
||||
anyFilter :: (Foldable f)
|
||||
=> f (t -> Set.Set Text-> E.SqlExpr (E.Value Bool))
|
||||
-> t
|
||||
-> Set.Set Text
|
||||
-> E.SqlExpr (E.Value Bool)
|
||||
anyFilter :: Foldable f
|
||||
=> f (t -> cs -> E.SqlExpr (E.Value Bool))
|
||||
-> (t -> cs -> E.SqlExpr (E.Value Bool))
|
||||
anyFilter fltrs needle criterias = F.foldr aux false fltrs
|
||||
where
|
||||
aux fltr acc = fltr needle criterias E.||. acc
|
||||
|
||||
-- | Combine several filters, using logical and
|
||||
allFilter :: (Foldable f)
|
||||
=> f (t -> Set.Set Text-> E.SqlExpr (E.Value Bool))
|
||||
-> t
|
||||
-> Set.Set Text
|
||||
-> E.SqlExpr (E.Value Bool)
|
||||
allFilter :: Foldable f
|
||||
=> f (t -> cs -> E.SqlExpr (E.Value Bool))
|
||||
-> (t -> cs -> E.SqlExpr (E.Value Bool))
|
||||
allFilter fltrs needle criterias = F.foldr aux true fltrs
|
||||
where
|
||||
aux fltr acc = fltr needle criterias E.&&. acc
|
||||
@ -199,3 +206,41 @@ selectExists query = do
|
||||
case res of
|
||||
[E.Value b] -> return b
|
||||
_other -> error "SELECT EXISTS ... returned zero or more than one rows"
|
||||
|
||||
|
||||
class SqlHashable a
|
||||
instance SqlHashable Text
|
||||
instance SqlHashable ByteString
|
||||
instance SqlHashable Lazy.Text
|
||||
instance SqlHashable Lazy.ByteString
|
||||
|
||||
|
||||
sha256 :: SqlHashable a => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value (Digest SHA256))
|
||||
sha256 = E.unsafeSqlFunction "digest" . (, E.val "sha256" :: E.SqlExpr (E.Value Text))
|
||||
|
||||
|
||||
maybe :: (PersistField a, PersistField b)
|
||||
=> E.SqlExpr (E.Value b)
|
||||
-> (E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value b))
|
||||
-> E.SqlExpr (E.Value (Maybe a))
|
||||
-> E.SqlExpr (E.Value b)
|
||||
maybe onNothing onJust val = E.case_
|
||||
[ E.when_
|
||||
(E.not_ $ E.isNothing val)
|
||||
E.then_
|
||||
(onJust $ E.veryUnsafeCoerceSqlExprValue val)
|
||||
]
|
||||
(E.else_ onNothing)
|
||||
|
||||
|
||||
class (PersistEntity entity, PersistField value) => SqlProject entity value entity' value' | entity value entity' -> value', entity value value' -> entity' where
|
||||
sqlProject :: E.SqlExpr entity' -> EntityField entity value -> E.SqlExpr (E.Value value')
|
||||
unSqlProject :: forall p1 p2. p1 entity -> p2 entity' -> value -> value'
|
||||
|
||||
instance (PersistEntity val, PersistField typ) => SqlProject val typ (E.Entity val) typ where
|
||||
sqlProject = (E.^.)
|
||||
unSqlProject _ _ = id
|
||||
|
||||
instance (PersistEntity val, PersistField typ) => SqlProject val typ (Maybe (E.Entity val)) (Maybe typ) where
|
||||
sqlProject = (E.?.)
|
||||
unSqlProject _ _ = Just
|
||||
|
||||
@ -65,7 +65,7 @@ import Control.Monad.Memo.Class (MonadMemo(..), for4)
|
||||
import qualified Control.Monad.Catch as C
|
||||
|
||||
import Handler.Utils.StudyFeatures
|
||||
import Utils.Lens
|
||||
import Handler.Utils.SchoolLdap
|
||||
import Utils.Form
|
||||
import Utils.Sheet
|
||||
import Utils.SystemMessage
|
||||
@ -152,6 +152,8 @@ deriving instance Generic MaterialR
|
||||
deriving instance Generic TutorialR
|
||||
deriving instance Generic ExamR
|
||||
deriving instance Generic CourseApplicationR
|
||||
deriving instance Generic AllocationR
|
||||
deriving instance Generic SchoolR
|
||||
deriving instance Generic (Route UniWorX)
|
||||
|
||||
-- | Convenient Type Synonyms:
|
||||
@ -261,6 +263,8 @@ instance RenderMessage UniWorX Int64 where
|
||||
renderMessage f ls = renderMessage f ls . tshow
|
||||
instance RenderMessage UniWorX Integer where
|
||||
renderMessage f ls = renderMessage f ls . tshow
|
||||
instance RenderMessage UniWorX Natural where
|
||||
renderMessage f ls = renderMessage f ls . tshow
|
||||
|
||||
instance HasResolution a => RenderMessage UniWorX (Fixed a) where
|
||||
renderMessage f ls = renderMessage f ls . showFixed True
|
||||
@ -281,8 +285,12 @@ instance RenderMessage UniWorX MsgLanguage where
|
||||
where
|
||||
mr = renderMessage foundation ls
|
||||
|
||||
instance RenderMessage UniWorX (UnsupportedAuthPredicate (Route UniWorX)) where
|
||||
renderMessage f ls (UnsupportedAuthPredicate tag route) = renderMessage f ls $ MsgUnsupportedAuthPredicate tag (show route)
|
||||
instance RenderMessage UniWorX (UnsupportedAuthPredicate AuthTag (Route UniWorX)) where
|
||||
renderMessage f ls (UnsupportedAuthPredicate tag route) = mr . MsgUnsupportedAuthPredicate (mr tag) $ Text.intercalate "/" pieces
|
||||
where
|
||||
mr :: forall msg. RenderMessage UniWorX msg => msg -> Text
|
||||
mr = renderMessage f ls
|
||||
(pieces, _) = renderRoute route
|
||||
|
||||
embedRenderMessage ''UniWorX ''MessageStatus ("Message" <>)
|
||||
embedRenderMessage ''UniWorX ''NotificationTrigger $ ("NotificationTrigger" <>) . concat . drop 1 . splitCamel
|
||||
@ -304,6 +312,7 @@ embedRenderMessage ''UniWorX ''SubmissionModeDescr
|
||||
embedRenderMessage ''UniWorX ''UploadModeDescr id
|
||||
embedRenderMessage ''UniWorX ''SecretJSONFieldException id
|
||||
embedRenderMessage ''UniWorX ''AFormMessage $ concat . drop 2 . splitCamel
|
||||
embedRenderMessage ''UniWorX ''SchoolFunction id
|
||||
|
||||
embedRenderMessage ''UniWorX ''AuthenticationMode id
|
||||
|
||||
@ -362,6 +371,11 @@ instance RenderMessage UniWorX a => RenderMessage UniWorX (ExamResult' a) where
|
||||
mr :: RenderMessage UniWorX msg => msg -> Text
|
||||
mr = renderMessage foundation ls
|
||||
|
||||
instance RenderMessage UniWorX (Either ExamPassed ExamGrade) where
|
||||
renderMessage foundation ls = either mr mr
|
||||
where
|
||||
mr :: RenderMessage UniWorX msg => msg -> Text
|
||||
mr = renderMessage foundation ls
|
||||
|
||||
-- ToMessage instances for converting raw numbers to Text (no internationalization)
|
||||
|
||||
@ -371,6 +385,8 @@ instance ToMessage Int64 where
|
||||
toMessage = tshow
|
||||
instance ToMessage Integer where
|
||||
toMessage = tshow
|
||||
instance ToMessage Natural where
|
||||
toMessage = tshow
|
||||
|
||||
instance HasResolution a => ToMessage (Fixed a) where
|
||||
toMessage = toMessage . showFixed True
|
||||
@ -593,17 +609,36 @@ tagAccessPredicate AuthAdmin = APDB $ \mAuthId route _ -> case route of
|
||||
CourseR tid ssh csh _ -> $cachedHereBinary (mAuthId, tid, ssh, csh) . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isAdmin <- lift . E.selectExists . E.from $ \(course `E.InnerJoin` userAdmin) -> do
|
||||
E.on $ course E.^. CourseSchool E.==. userAdmin E.^. UserAdminSchool
|
||||
E.where_ $ userAdmin E.^. UserAdminUser E.==. E.val authId
|
||||
E.on $ course E.^. CourseSchool E.==. userAdmin E.^. UserFunctionSchool
|
||||
E.where_ $ userAdmin E.^. UserFunctionUser E.==. E.val authId
|
||||
E.&&. userAdmin E.^. UserFunctionFunction E.==. E.val SchoolAdmin
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
guardMExceptT isAdmin (unauthorizedI MsgUnauthorizedSchoolAdmin)
|
||||
return Authorized
|
||||
-- Allocations: access only to school admins
|
||||
AllocationR tid ssh ash _ -> $cachedHereBinary (mAuthId, tid, ssh, ash) . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isAdmin <- lift . E.selectExists . E.from $ \(allocation `E.InnerJoin` userAdmin) -> do
|
||||
E.on $ allocation E.^. AllocationSchool E.==. userAdmin E.^. UserFunctionSchool
|
||||
E.where_ $ userAdmin E.^. UserFunctionUser E.==. E.val authId
|
||||
E.&&. userAdmin E.^. UserFunctionFunction E.==. E.val SchoolAdmin
|
||||
E.&&. allocation E.^. AllocationTerm E.==. E.val tid
|
||||
E.&&. allocation E.^. AllocationSchool E.==. E.val ssh
|
||||
E.&&. allocation E.^. AllocationShorthand E.==. E.val ash
|
||||
guardMExceptT isAdmin (unauthorizedI MsgUnauthorizedSchoolAdmin)
|
||||
return Authorized
|
||||
-- Schools: access only to school admins
|
||||
SchoolR ssh _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isAdmin <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolAdmin]
|
||||
guardMExceptT isAdmin (unauthorizedI MsgUnauthorizedSchoolAdmin)
|
||||
return Authorized
|
||||
-- other routes: access to any admin is granted here
|
||||
_other -> $cachedHereBinary mAuthId . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
adrights <- lift $ selectFirst [UserAdminUser ==. authId] []
|
||||
adrights <- lift $ selectFirst [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolAdmin] []
|
||||
guardMExceptT (isJust adrights) (unauthorizedI MsgUnauthorizedSiteAdmin)
|
||||
return Authorized
|
||||
tagAccessPredicate AuthToken = APDB $ \mAuthId route isWrite -> exceptT return return $
|
||||
@ -612,10 +647,9 @@ tagAccessPredicate AuthNoEscalation = APDB $ \mAuthId route _ -> case route of
|
||||
AdminHijackUserR cID -> exceptT return return $ do
|
||||
myUid <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
uid <- decrypt cID
|
||||
otherSchoolsAdmin <- lift $ Set.fromList . map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. uid] []
|
||||
otherSchoolsLecturer <- lift $ Set.fromList . map (userLecturerSchool . entityVal) <$> selectList [UserLecturerUser ==. uid] []
|
||||
mySchools <- lift $ Set.fromList . map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. myUid] []
|
||||
guardMExceptT ((otherSchoolsAdmin `Set.union` otherSchoolsLecturer) `Set.isSubsetOf` mySchools) (unauthorizedI MsgUnauthorizedAdminEscalation)
|
||||
otherSchoolsFunctions <- lift $ Set.fromList . map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid] []
|
||||
mySchools <- lift $ Set.fromList . map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. myUid, UserFunctionFunction ==. SchoolAdmin] []
|
||||
guardMExceptT (otherSchoolsFunctions `Set.isSubsetOf` mySchools) (unauthorizedI MsgUnauthorizedAdminEscalation)
|
||||
return Authorized
|
||||
r -> $unsupportedAuthPredicate AuthNoEscalation r
|
||||
tagAccessPredicate AuthDeprecated = APHandler $ \_ r _ -> do
|
||||
@ -641,10 +675,22 @@ tagAccessPredicate AuthLecturer = APDB $ \mAuthId route _ -> case route of
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
guardMExceptT isLecturer (unauthorizedI MsgUnauthorizedLecturer)
|
||||
return Authorized
|
||||
AllocationR tid ssh ash _ -> $cachedHereBinary (mAuthId, tid, ssh, ash) . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isLecturer <- lift . E.selectExists . E.from $ \(allocation `E.InnerJoin` allocationCourse `E.InnerJoin` course `E.InnerJoin` lecturer) -> do
|
||||
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
|
||||
E.on $ course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse
|
||||
E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
|
||||
E.where_ $ lecturer E.^. LecturerUser E.==. E.val authId
|
||||
E.&&. allocation E.^. AllocationTerm E.==. E.val tid
|
||||
E.&&. allocation E.^. AllocationSchool E.==. E.val ssh
|
||||
E.&&. allocation E.^. AllocationShorthand E.==. E.val ash
|
||||
guardMExceptT isLecturer (unauthorizedI MsgUnauthorizedAllocationLecturer)
|
||||
return Authorized
|
||||
-- lecturer for any school will do
|
||||
_ -> $cachedHereBinary mAuthId . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
void . maybeMExceptT (unauthorizedI MsgUnauthorizedSchoolLecturer) $ selectFirst [UserLecturerUser ==. authId] []
|
||||
void . maybeMExceptT (unauthorizedI MsgUnauthorizedSchoolLecturer) $ selectFirst [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolLecturer] []
|
||||
return Authorized
|
||||
tagAccessPredicate AuthCorrector = APDB $ \mAuthId route _ -> exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
@ -711,9 +757,7 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
|
||||
guard $ NTop (Just cTime) <= NTop allocationStaffAllocationTo
|
||||
|
||||
return Authorized
|
||||
|
||||
|
||||
|
||||
|
||||
CExamR tid ssh csh examn subRoute -> maybeT (unauthorizedI MsgUnauthorizedExamTime) $ do
|
||||
course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
|
||||
Entity eId Exam{..} <- $cachedHereBinary (course, examn) . MaybeT . getBy $ UniqueExam course examn
|
||||
@ -822,9 +866,34 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
|
||||
guard $ NTop (Just now) >= NTop deregUntil
|
||||
return Authorized
|
||||
_other -> unauthorizedI MsgUnauthorizedCourseTime
|
||||
|
||||
CApplicationR tid ssh csh _ _ -> maybeT (unauthorizedI MsgUnauthorizedApplicationTime) $ do
|
||||
Entity course Course{..} <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
|
||||
allocationCourse <- $cachedHereBinary course . lift . getBy $ UniqueAllocationCourse course
|
||||
allocation <- for allocationCourse $ \(Entity _ AllocationCourse{..}) -> $cachedHereBinary allocationCourseAllocation . MaybeT $ get allocationCourseAllocation
|
||||
|
||||
case allocation of
|
||||
Nothing -> do
|
||||
cTime <- liftIO getCurrentTime
|
||||
guard $ maybe False (cTime >=) courseRegisterFrom
|
||||
guard $ maybe True (cTime <=) courseRegisterTo
|
||||
Just Allocation{..} -> do
|
||||
cTime <- liftIO getCurrentTime
|
||||
guard $ NTop allocationRegisterFrom <= NTop (Just cTime)
|
||||
guard $ NTop (Just cTime) <= NTop allocationRegisterTo
|
||||
|
||||
return Authorized
|
||||
|
||||
AllocationR tid ssh ash _ -> maybeT (unauthorizedI MsgUnauthorizedAllocationRegisterTime) $ do
|
||||
-- Checks `registerFrom` and `registerTo`, override as further routes become available
|
||||
now <- liftIO getCurrentTime
|
||||
Entity _ Allocation{..} <- MaybeT . $cachedHereBinary (tid, ssh, ash) . getBy $ TermSchoolAllocationShort tid ssh ash
|
||||
guard $ NTop allocationRegisterFrom <= NTop (Just now)
|
||||
guard $ NTop (Just now) <= NTop allocationRegisterTo
|
||||
return Authorized
|
||||
|
||||
MessageR cID -> maybeT (unauthorizedI MsgUnauthorizedSystemMessageTime) $ do
|
||||
smId <- decrypt cID
|
||||
smId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
|
||||
SystemMessage{systemMessageFrom, systemMessageTo} <- $cachedHereBinary smId . MaybeT $ get smId
|
||||
cTime <- (NTop . Just) <$> liftIO getCurrentTime
|
||||
guard $ NTop systemMessageFrom <= cTime
|
||||
@ -832,6 +901,30 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
|
||||
return Authorized
|
||||
|
||||
r -> $unsupportedAuthPredicate AuthTime r
|
||||
tagAccessPredicate AuthStaffTime = APDB $ \_ route _ -> case route of
|
||||
CApplicationR tid ssh csh _ _ -> maybeT (unauthorizedI MsgUnauthorizedApplicationTime) $ do
|
||||
course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
|
||||
allocationCourse <- $cachedHereBinary course . lift . getBy $ UniqueAllocationCourse course
|
||||
allocation <- for allocationCourse $ \(Entity _ AllocationCourse{..}) -> $cachedHereBinary allocationCourseAllocation . MaybeT $ get allocationCourseAllocation
|
||||
|
||||
case allocation of
|
||||
Nothing -> return ()
|
||||
Just Allocation{..} -> do
|
||||
cTime <- liftIO getCurrentTime
|
||||
guard $ NTop allocationStaffAllocationFrom <= NTop (Just cTime)
|
||||
guard $ NTop (Just cTime) <= NTop allocationStaffAllocationTo
|
||||
|
||||
return Authorized
|
||||
|
||||
AllocationR tid ssh ash _ -> maybeT (unauthorizedI MsgUnauthorizedAllocationRegisterTime) $ do
|
||||
-- Checks `registerFrom` and `registerTo`, override as further routes become available
|
||||
now <- liftIO getCurrentTime
|
||||
Entity _ Allocation{..} <- MaybeT . $cachedHereBinary (tid, ssh, ash) . getBy $ TermSchoolAllocationShort tid ssh ash
|
||||
guard $ NTop allocationStaffAllocationFrom <= NTop (Just now)
|
||||
guard $ NTop (Just now) <= NTop allocationStaffAllocationTo
|
||||
return Authorized
|
||||
|
||||
r -> $unsupportedAuthPredicate AuthStaffTime r
|
||||
tagAccessPredicate AuthAllocationTime = APDB $ \mAuthId route _ -> case route of
|
||||
CourseR tid ssh csh CRegisterR -> do
|
||||
now <- liftIO getCurrentTime
|
||||
@ -969,12 +1062,20 @@ tagAccessPredicate AuthExamResult = APDB $ \mAuthId route _ -> case route of
|
||||
guardMExceptT hasResult (unauthorizedI MsgUnauthorizedExamResult)
|
||||
return Authorized
|
||||
r -> $unsupportedAuthPredicate AuthExamRegistered r
|
||||
tagAccessPredicate AuthAllocationRegistered = APDB $ \mAuthId route _ -> case route of
|
||||
AllocationR tid ssh ash _ -> maybeT (unauthorizedI MsgUnauthorizedAllocationRegistered) $ do
|
||||
uid <- hoistMaybe mAuthId
|
||||
aId <- MaybeT . $cachedHereBinary (tid, ssh, ash) . getKeyBy $ TermSchoolAllocationShort tid ssh ash
|
||||
void . MaybeT . $cachedHereBinary (uid, aId) . getKeyBy $ UniqueAllocationUser aId uid
|
||||
return Authorized
|
||||
r -> $unsupportedAuthPredicate AuthAllocationRegistered r
|
||||
tagAccessPredicate AuthParticipant = APDB $ \_ route _ -> case route of
|
||||
CourseR tid ssh csh (CUserR cID) -> exceptT return return $ do
|
||||
cTime <- liftIO getCurrentTime
|
||||
let authorizedIfExists f = do
|
||||
[E.Value ok] <- lift . E.select . return . E.exists $ E.from f
|
||||
whenExceptT ok Authorized
|
||||
participant <- decrypt cID
|
||||
participant <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedParticipant) (const True :: CryptoIDError -> Bool) $ decrypt cID
|
||||
-- participant is currently registered
|
||||
$cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` courseParticipant) -> do
|
||||
E.on $ course E.^. CourseId E.==. courseParticipant E.^. CourseParticipantCourse
|
||||
@ -1030,6 +1131,17 @@ tagAccessPredicate AuthParticipant = APDB $ \_ route _ -> case route of
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
-- participant is applicant for this course
|
||||
$cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \((course `E.InnerJoin` courseApplication) `E.LeftOuterJoin` allocation) -> do
|
||||
E.on $ allocation E.?. AllocationId E.==. courseApplication E.^. CourseApplicationAllocation
|
||||
E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
|
||||
E.where_ $ courseApplication E.^. CourseApplicationUser E.==. E.val participant
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
E.where_ $ E.maybe E.true (E.maybe E.false $ \f -> f E.<=. E.val cTime) (allocation E.?. AllocationStaffAllocationFrom)
|
||||
E.&&. E.maybe E.true (E.maybe E.true $ \t -> t E.>=. E.val cTime) (allocation E.?. AllocationStaffAllocationTo)
|
||||
|
||||
unauthorizedI MsgUnauthorizedParticipant
|
||||
r -> $unsupportedAuthPredicate AuthParticipant r
|
||||
tagAccessPredicate AuthCapacity = APDB $ \_ route _ -> case route of
|
||||
@ -1105,20 +1217,21 @@ tagAccessPredicate AuthCorrectorSubmissions = APDB $ \_ route _ -> case route of
|
||||
return Authorized
|
||||
r -> $unsupportedAuthPredicate AuthCorrectorSubmissions r
|
||||
tagAccessPredicate AuthSelf = APDB $ \mAuthId route _ -> exceptT return return $ do
|
||||
referencedUser <- case route of
|
||||
AdminUserR cID -> decrypt cID
|
||||
AdminUserDeleteR cID -> decrypt cID
|
||||
AdminHijackUserR cID -> decrypt cID
|
||||
UserNotificationR cID -> decrypt cID
|
||||
UserPasswordR cID -> decrypt cID
|
||||
CourseR _ _ _ (CUserR cID) -> decrypt cID
|
||||
referencedUser' <- case route of
|
||||
AdminUserR cID -> return $ Left cID
|
||||
AdminUserDeleteR cID -> return $ Left cID
|
||||
AdminHijackUserR cID -> return $ Left cID
|
||||
UserNotificationR cID -> return $ Left cID
|
||||
UserPasswordR cID -> return $ Left cID
|
||||
CourseR _ _ _ (CUserR cID) -> return $ Left cID
|
||||
CApplicationR _ _ _ cID _ -> do
|
||||
appId <- decrypt cID
|
||||
application <- $cachedHereBinary appId . lift $ get appId
|
||||
case application of
|
||||
Nothing -> throwError =<< unauthorizedI MsgUnauthorizedSelf
|
||||
Just CourseApplication{..} -> return courseApplicationUser
|
||||
appId <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedSelf) (const True :: CryptoIDError -> Bool) $ decrypt cID
|
||||
CourseApplication{..} <- maybeMExceptT (unauthorizedI MsgUnauthorizedSelf) . $cachedHereBinary appId $ get appId
|
||||
return $ Right courseApplicationUser
|
||||
_other -> throwError =<< $unsupportedAuthPredicate AuthSelf route
|
||||
referencedUser <- case referencedUser' of
|
||||
Right uid -> return uid
|
||||
Left cID -> catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedSelf) (const True :: CryptoIDError -> Bool) $ decrypt cID
|
||||
case mAuthId of
|
||||
Just uid
|
||||
| uid == referencedUser -> return Authorized
|
||||
@ -1133,7 +1246,7 @@ tagAccessPredicate AuthIsLDAP = APDB $ \_ route _ -> exceptT return return $ do
|
||||
UserPasswordR cID -> return cID
|
||||
CourseR _ _ _ (CUserR cID) -> return cID
|
||||
_other -> throwError =<< $unsupportedAuthPredicate AuthIsLDAP route
|
||||
referencedUser' <- decrypt referencedUser
|
||||
referencedUser' <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedSelf) (const True :: CryptoIDError -> Bool) $ decrypt referencedUser
|
||||
maybeTMExceptT (unauthorizedI MsgUnauthorizedLDAP) $ do
|
||||
User{..} <- MaybeT $ get referencedUser'
|
||||
guard $ userAuthentication == AuthLDAP
|
||||
@ -1147,14 +1260,14 @@ tagAccessPredicate AuthIsPWHash = APDB $ \_ route _ -> exceptT return return $ d
|
||||
UserPasswordR cID -> return cID
|
||||
CourseR _ _ _ (CUserR cID) -> return cID
|
||||
_other -> throwError =<< $unsupportedAuthPredicate AuthIsPWHash route
|
||||
referencedUser' <- decrypt referencedUser
|
||||
referencedUser' <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedSelf) (const True :: CryptoIDError -> Bool) $ decrypt referencedUser
|
||||
maybeTMExceptT (unauthorizedI MsgUnauthorizedPWHash) $ do
|
||||
User{..} <- MaybeT $ get referencedUser'
|
||||
guard $ is _AuthPWHash userAuthentication
|
||||
return Authorized
|
||||
tagAccessPredicate AuthAuthentication = APDB $ \mAuthId route _ -> case route of
|
||||
MessageR cID -> maybeT (unauthorizedI MsgUnauthorizedSystemMessageAuth) $ do
|
||||
smId <- decrypt cID
|
||||
smId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
|
||||
SystemMessage{..} <- $cachedHereBinary smId . MaybeT $ get smId
|
||||
let isAuthenticated = isJust mAuthId
|
||||
guard $ not systemMessageAuthenticatedOnly || isAuthenticated
|
||||
@ -1575,6 +1688,8 @@ siteLayout' headingOverride widget = do
|
||||
hasPageActions = hasPrimaryPageActions || hasSecondaryPageActions
|
||||
hasSecondaryPageActions = any (is _PageActionSecondary) $ toListOf (traverse . _1 . _menuItemType) menuTypes
|
||||
hasPrimaryPageActions = any (is _PageActionPrime) $ toListOf (traverse . _1 . _menuItemType) menuTypes
|
||||
contentRibbon :: Maybe Widget
|
||||
contentRibbon = fmap toWidget appRibbon
|
||||
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
let
|
||||
@ -1588,7 +1703,6 @@ siteLayout' headingOverride widget = do
|
||||
addStylesheet $ StaticR bundles_css_vendor_css
|
||||
addStylesheet $ StaticR bundles_css_main_css
|
||||
-- JavaScript
|
||||
addScript $ StaticR bundles_js_polyfills_js
|
||||
addScript $ StaticR bundles_js_vendor_js
|
||||
addScript $ StaticR bundles_js_main_js
|
||||
toWidget $(juliusFile "templates/i18n.julius")
|
||||
@ -1632,10 +1746,15 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb AdminFeaturesR = return ("Test" , Just AdminR)
|
||||
breadcrumb AdminTestR = return ("Test" , Just AdminR)
|
||||
breadcrumb AdminErrMsgR = return ("Test" , Just AdminR)
|
||||
|
||||
breadcrumb SchoolListR = return ("Institute" , Just AdminR)
|
||||
breadcrumb (SchoolR ssh SchoolEditR) = return (original (unSchoolKey ssh), Just SchoolListR)
|
||||
breadcrumb SchoolNewR = return ("Neu" , Just SchoolListR)
|
||||
|
||||
breadcrumb InfoR = return ("Information" , Nothing)
|
||||
breadcrumb InfoLecturerR = return ("Veranstalter" , Just InfoR)
|
||||
breadcrumb DataProtR = return ("Datenschutz" , Just InfoR)
|
||||
breadcrumb InfoAllocationR = return ("Zentralanmeldungen", Just InfoR)
|
||||
breadcrumb ImpressumR = return ("Impressum" , Just InfoR)
|
||||
breadcrumb VersionR = return ("Versionsgeschichte", Just InfoR)
|
||||
|
||||
@ -1659,6 +1778,12 @@ instance YesodBreadcrumbs UniWorX where
|
||||
|
||||
breadcrumb (TermSchoolCourseListR tid ssh) = return (original $ unSchoolKey ssh, Just $ TermCourseListR tid)
|
||||
|
||||
breadcrumb AllocationListR = return ("Zentralanmeldungen", Just HomeR)
|
||||
breadcrumb (AllocationR tid ssh ash AShowR) = do
|
||||
mr <- getMessageRender
|
||||
Entity _ Allocation{allocationName} <- runDB . getBy404 $ TermSchoolAllocationShort tid ssh ash
|
||||
return ([st|#{allocationName} (#{mr (ShortTermIdentifier (unTermKey tid))}, #{original (unSchoolKey ssh)})|], Just $ AllocationListR)
|
||||
|
||||
breadcrumb CourseListR = return ("Kurse" , Nothing)
|
||||
breadcrumb CourseNewR = return ("Neu" , Just CourseListR)
|
||||
breadcrumb (CourseR tid ssh csh CShowR) = return (original csh, Just $ TermSchoolCourseListR tid ssh)
|
||||
@ -1681,6 +1806,10 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb (CourseR tid ssh csh CExamListR) = return ("Prüfungen", Just $ CourseR tid ssh csh CShowR)
|
||||
breadcrumb (CourseR tid ssh csh CExamNewR) = return ("Anlegen", Just $ CourseR tid ssh csh CExamListR)
|
||||
|
||||
breadcrumb (CourseR tid ssh csh CApplicationsR) = return ("Bewerbungen", Just $ CourseR tid ssh csh CShowR)
|
||||
|
||||
breadcrumb (CApplicationR tid ssh csh _ CAEditR) = return ("Bewerbung", Just $ CourseR tid ssh csh CApplicationsR)
|
||||
|
||||
breadcrumb (CExamR tid ssh csh examn EShowR) = return (original examn, Just $ CourseR tid ssh csh CExamListR)
|
||||
breadcrumb (CExamR tid ssh csh examn EEditR) = return ("Bearbeiten", Just $ CExamR tid ssh csh examn EShowR)
|
||||
breadcrumb (CExamR tid ssh csh examn EUsersR) = return ("Teilnehmer", Just $ CExamR tid ssh csh examn EShowR)
|
||||
@ -1875,15 +2004,33 @@ pageActions (HomeR) =
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgAdminHeading
|
||||
, menuItemIcon = Just "screwdriver"
|
||||
, menuItemRoute = SomeRoute AdminR
|
||||
, menuItemLabel = MsgMenuOpenCourses
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute (CourseListR, [("courses-openregistration", "True")])
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuOpenAllocations
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute (AllocationListR, [("allocations-active", "True")])
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (AdminR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSchoolList
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute SchoolListR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgAdminFeaturesHeading
|
||||
, menuItemIcon = Nothing
|
||||
@ -1907,40 +2054,6 @@ pageActions (HomeR) =
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (AdminR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgAdminFeaturesHeading
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute AdminFeaturesR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuMessageList
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute MessageListR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgErrMsgHeading
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute AdminErrMsgR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuUsers
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute UsersR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuAdminTest
|
||||
@ -1950,12 +2063,22 @@ pageActions (AdminR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (SchoolListR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSchoolNew
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute SchoolNewR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (UsersR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuLecturerInvite
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute AdminNewLecturerInviteR
|
||||
, menuItemRoute = SomeRoute AdminNewFunctionaryInviteR
|
||||
, menuItemModal = True
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
@ -2079,7 +2202,7 @@ pageActions (TermCourseListR tid) =
|
||||
]
|
||||
pageActions (TermSchoolCourseListR _tid _ssh) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCourseNew
|
||||
, menuItemIcon = Just "book"
|
||||
, menuItemRoute = SomeRoute CourseNewR
|
||||
@ -2087,6 +2210,16 @@ pageActions (TermSchoolCourseListR _tid _ssh) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (AllocationR _tid _ssh _ash AShowR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuAllocationInfo
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute InfoAllocationR
|
||||
, menuItemModal = True
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (CourseListR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
@ -2096,6 +2229,14 @@ pageActions (CourseListR) =
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuAllocationList
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute AllocationListR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (CourseNewR) = [
|
||||
MenuItem
|
||||
@ -2174,6 +2315,28 @@ pageActions (CourseR tid ssh csh CShowR) =
|
||||
anyM examNames $ examAccess . E.unValue
|
||||
in runDB $ lecturerAccess `or2M` existsVisible
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuCourseApplications
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CApplicationsR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' =
|
||||
let courseWhere course = course <$ do
|
||||
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
|
||||
existsApplications = E.selectExists . E.from $ \(course `E.InnerJoin` courseApplication) -> do
|
||||
E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
|
||||
void $ courseWhere course
|
||||
courseApplications = fmap (any E.unValue) . E.select . E.from $ \course -> do
|
||||
void $ courseWhere course
|
||||
return $ course E.^. CourseApplicationsRequired
|
||||
courseAllocation = E.selectExists . E.from $ \(course `E.InnerJoin` allocationCourse) -> do
|
||||
E.on $ course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse
|
||||
void $ courseWhere course
|
||||
in runDB $ courseAllocation `or2M` courseApplications `or2M` existsApplications
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuCourseMembers
|
||||
@ -2590,6 +2753,28 @@ pageActions (CSheetR tid ssh csh shn SCorrR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (CourseR tid ssh csh CApplicationsR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCourseApplicationsFiles
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CAppsFilesR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback'
|
||||
= let appAccess (E.Value appId) = do
|
||||
cID <- encrypt appId
|
||||
hasReadAccessTo $ CApplicationR tid ssh csh cID CAFilesR
|
||||
appSource = E.selectSource . E.from $ \(course `E.InnerJoin` courseApplication) -> do
|
||||
E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
|
||||
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.where_ . E.exists . E.from $ \courseApplicationFile ->
|
||||
E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. courseApplication E.^. CourseApplicationId
|
||||
return $ courseApplication E.^. CourseApplicationId
|
||||
in runDB . runConduit $ appSource .| anyMC appAccess
|
||||
}
|
||||
]
|
||||
pageActions (CorrectionsR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
@ -2721,13 +2906,6 @@ pageHeading (TermSchoolCourseListR tid ssh)
|
||||
School{schoolName=school} <- handlerToWidget $ runDB $ get404 ssh
|
||||
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)
|
||||
= Just $ i18nHeading $ MsgCourseListTitle
|
||||
pageHeading CourseNewR
|
||||
@ -2866,7 +3044,8 @@ data CampusUserConversionException
|
||||
| CampusUserInvalidSurname
|
||||
| CampusUserInvalidTitle
|
||||
| CampusUserInvalidMatriculation
|
||||
| CampusUserInvalidFeaturesOfStudy String
|
||||
| CampusUserInvalidFeaturesOfStudy Text
|
||||
| CampusUserInvalidAssociatedSchools Text
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
instance Exception CampusUserConversionException
|
||||
|
||||
@ -2940,15 +3119,19 @@ upsertCampusUser ldapData Creds{..} = do
|
||||
, userDateFormat = userDefaultDateFormat
|
||||
, userTimeFormat = userDefaultTimeFormat
|
||||
, userDownloadFiles = userDefaultDownloadFiles
|
||||
, userWarningDays = userDefaultWarningDays
|
||||
, userNotificationSettings = def
|
||||
, userMailLanguages = def
|
||||
, userTokensIssuedAfter = Nothing
|
||||
, userCreated = now
|
||||
, userLastLdapSynchronisation = Just now
|
||||
, ..
|
||||
}
|
||||
userUpdate = [ UserMatrikelnummer =. userMatrikelnummer
|
||||
, UserDisplayName =. userDisplayName
|
||||
, UserSurname =. userSurname
|
||||
, UserEmail =. userEmail
|
||||
userUpdate = [ UserMatrikelnummer =. userMatrikelnummer
|
||||
, UserDisplayName =. userDisplayName
|
||||
, UserSurname =. userSurname
|
||||
, UserEmail =. userEmail
|
||||
, UserLastLdapSynchronisation =. Just now
|
||||
] ++
|
||||
[ UserLastAuthentication =. Just now | not isDummy ]
|
||||
|
||||
@ -2970,7 +3153,7 @@ upsertCampusUser ldapData Creds{..} = do
|
||||
Right str <- return $ Text.decodeUtf8' v'
|
||||
return str
|
||||
|
||||
fs <- either (throwM . CampusUserInvalidFeaturesOfStudy . unpack) return userStudyFeatures
|
||||
fs <- either (throwM . CampusUserInvalidFeaturesOfStudy . tshow) return userStudyFeatures
|
||||
|
||||
let
|
||||
studyTermCandidates = Set.fromList $ do
|
||||
@ -3000,13 +3183,56 @@ upsertCampusUser ldapData Creds{..} = do
|
||||
insertMaybe studyFeaturesDegree $ StudyDegree (unStudyDegreeKey studyFeaturesDegree) Nothing Nothing
|
||||
insertMaybe studyFeaturesField $ StudyTerms (unStudyTermsKey studyFeaturesField) Nothing Nothing
|
||||
void $ upsert f [StudyFeaturesUpdated =. now, StudyFeaturesValid =. True]
|
||||
associateUserSchoolsByTerms userId
|
||||
|
||||
let
|
||||
userAssociatedSchools = fmap concat $ forM userAssociatedSchools' parseLdapSchools
|
||||
userAssociatedSchools' = do
|
||||
(k, v) <- ldapData
|
||||
guard $ k == ldapUserSchoolAssociation
|
||||
v' <- v
|
||||
Right str <- return $ Text.decodeUtf8' v'
|
||||
return str
|
||||
|
||||
ss <- either (throwM . CampusUserInvalidAssociatedSchools . tshow) return userAssociatedSchools
|
||||
|
||||
forM_ ss $ \frag -> void . runMaybeT $ do
|
||||
let
|
||||
exactMatch = MaybeT . getBy $ UniqueOrgUnit frag
|
||||
infixMatch = (hoistMaybe . preview _head =<<) . lift . E.select . E.from $ \schoolLdap -> do
|
||||
E.where_ $ E.val frag `E.isInfixOf` schoolLdap E.^. SchoolLdapOrgUnit
|
||||
E.&&. E.not_ (E.isNothing $ schoolLdap E.^. SchoolLdapSchool)
|
||||
return schoolLdap
|
||||
Entity _ SchoolLdap{..} <- exactMatch <|> infixMatch
|
||||
ssh <- hoistMaybe schoolLdapSchool
|
||||
|
||||
lift . void $ insertUnique UserSchool
|
||||
{ userSchoolUser = userId
|
||||
, userSchoolSchool = ssh
|
||||
, userSchoolIsOptOut = False
|
||||
}
|
||||
|
||||
forM_ ss $ void . insertUnique . SchoolLdap Nothing
|
||||
|
||||
return user
|
||||
where
|
||||
insertMaybe key val = get key >>= maybe (insert_ val) (\_ -> return ())
|
||||
isDummy = credsPlugin == "dummy"
|
||||
isPWHash = credsPlugin == "PWHash"
|
||||
|
||||
associateUserSchoolsByTerms :: UserId -> DB ()
|
||||
associateUserSchoolsByTerms uid = do
|
||||
sfs <- selectList [StudyFeaturesUser ==. uid] []
|
||||
|
||||
forM_ sfs $ \(Entity _ StudyFeatures{..}) -> do
|
||||
schoolTerms <- selectList [SchoolTermsTerms ==. studyFeaturesField] []
|
||||
forM_ schoolTerms $ \(Entity _ SchoolTerms{..}) ->
|
||||
void $ insertUnique UserSchool
|
||||
{ userSchoolUser = uid
|
||||
, userSchoolSchool = schoolTermsSchool
|
||||
, userSchoolIsOptOut = False
|
||||
}
|
||||
|
||||
|
||||
instance YesodAuth UniWorX where
|
||||
type AuthId UniWorX = UserId
|
||||
@ -3068,6 +3294,11 @@ instance YesodAuth UniWorX where
|
||||
|
||||
acceptExisting = do
|
||||
res <- maybe (UserError $ IdentifierNotFound credsIdent) (Authenticated . entityKey) <$> getBy uAuth
|
||||
case res of
|
||||
Authenticated uid
|
||||
-> associateUserSchoolsByTerms uid
|
||||
_other
|
||||
-> return ()
|
||||
case res of
|
||||
Authenticated uid
|
||||
| not isDummy -> res <$ update uid [ UserLastAuthentication =. Just now ]
|
||||
|
||||
@ -8,8 +8,6 @@ import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder)
|
||||
import Control.Monad.Trans.Except
|
||||
import Control.Monad.Trans.Writer (mapWriterT)
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
-- import Data.Time
|
||||
import Data.Char (isDigit)
|
||||
import qualified Data.Text as Text
|
||||
@ -21,7 +19,7 @@ import qualified Data.Map as Map
|
||||
|
||||
import Database.Persist.Sql (fromSqlKey)
|
||||
import qualified Database.Esqueleto as E
|
||||
import Database.Esqueleto.Utils as E
|
||||
import Database.Esqueleto.Utils (mkExactFilter, mkContainsFilter)
|
||||
|
||||
import Handler.Utils.Table.Cells
|
||||
import qualified Handler.Utils.TermCandidates as Candidates
|
||||
@ -291,6 +289,7 @@ instance Button UniWorX ButtonAdminStudyTerms where
|
||||
getAdminFeaturesR, postAdminFeaturesR :: Handler Html
|
||||
getAdminFeaturesR = postAdminFeaturesR
|
||||
postAdminFeaturesR = do
|
||||
uid <- requireAuthId
|
||||
((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("infer-button" :: Text) (buttonForm :: Form ButtonAdminStudyTerms)
|
||||
let btnForm = wrapForm btnWdgt def
|
||||
{ formAction = Just $ SomeRoute AdminFeaturesR
|
||||
@ -324,11 +323,21 @@ postAdminFeaturesR = do
|
||||
newStudyTermKeys <- fromMaybe [] <$> lookupSessionJson SessionNewStudyTerms
|
||||
( (degreeResult,degreeTable)
|
||||
, (studyTermsResult,studytermsTable)
|
||||
, ((), candidateTable)) <- runDB $ (,,)
|
||||
<$> mkDegreeTable
|
||||
<*> mkStudytermsTable (Set.fromList newStudyTermKeys)
|
||||
(Set.fromList $ map entityKey infConflicts)
|
||||
<*> mkCandidateTable
|
||||
, ((), candidateTable)
|
||||
, userSchools) <- runDB $ do
|
||||
schools <- E.select . E.from $ \school -> do
|
||||
E.where_ . E.exists . E.from $ \schoolFunction ->
|
||||
E.where_ $ schoolFunction E.^. UserFunctionSchool E.==. school E.^. SchoolId
|
||||
E.&&. schoolFunction E.^. UserFunctionUser E.==. E.val uid
|
||||
E.&&. schoolFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin
|
||||
return school
|
||||
(,,,)
|
||||
<$> mkDegreeTable
|
||||
<*> mkStudytermsTable (Set.fromList newStudyTermKeys)
|
||||
(Set.fromList $ map entityKey infConflicts)
|
||||
(Set.fromList schools)
|
||||
<*> mkCandidateTable
|
||||
<*> pure schools
|
||||
|
||||
-- This needs to happen after calls to `dbTable` so they can short-circuit correctly
|
||||
unless (null infConflicts) $ addMessageI Warning MsgStudyFeatureConflict
|
||||
@ -343,12 +352,16 @@ postAdminFeaturesR = do
|
||||
void . runDB $ Map.traverseWithKey updateDegree res
|
||||
addMessageI Success MsgStudyDegreeChangeSuccess
|
||||
|
||||
let studyTermsResult' :: FormResult (Map (Key StudyTerms) (Maybe Text, Maybe Text))
|
||||
let studyTermsResult' :: FormResult (Map (Key StudyTerms) (Maybe Text, Maybe Text, Set SchoolId))
|
||||
studyTermsResult' = studyTermsResult <&> getDBFormResult
|
||||
(\row -> ( row ^. _dbrOutput . _entityVal . _studyTermsName
|
||||
, row ^. _dbrOutput . _entityVal . _studyTermsShorthand
|
||||
(\row -> ( row ^. _dbrOutput . _1 . _entityVal . _studyTermsName
|
||||
, row ^. _dbrOutput . _1 . _entityVal . _studyTermsShorthand
|
||||
, row ^. _dbrOutput . _2
|
||||
))
|
||||
updateStudyTerms studyTermsKey (name,short) = update studyTermsKey [StudyTermsName =. name, StudyTermsShorthand =. short]
|
||||
updateStudyTerms studyTermsKey (name,short,schools) = do
|
||||
update studyTermsKey [StudyTermsName =. name, StudyTermsShorthand =. short]
|
||||
forM_ schools $ \ssh -> void . insertUnique $ SchoolTerms ssh studyTermsKey
|
||||
deleteWhere [SchoolTermsTerms ==. studyTermsKey, SchoolTermsSchool /<-. Set.toList schools, SchoolTermsSchool <-. toListOf (folded . _entityKey) userSchools]
|
||||
formResult studyTermsResult' $ \res -> do
|
||||
void . runDB $ Map.traverseWithKey updateStudyTerms res
|
||||
addMessageI Success MsgStudyTermsChangeSuccess
|
||||
@ -357,24 +370,41 @@ postAdminFeaturesR = do
|
||||
setTitleI MsgAdminFeaturesHeading
|
||||
$(widgetFile "adminFeatures")
|
||||
where
|
||||
textInputCell lensRes lensDefault = formCell id (return . view (_dbrOutput . _entityKey))
|
||||
textInputCell :: Ord i
|
||||
=> Lens' a (Maybe Text)
|
||||
-> Getter (DBRow r) (Maybe Text)
|
||||
-> Getter (DBRow r) i
|
||||
-> DBRow r
|
||||
-> DBCell (MForm (HandlerT UniWorX IO)) (FormResult (DBFormResult i a (DBRow r)))
|
||||
textInputCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex)
|
||||
(\row _mkUnique -> (\(res,fieldView) -> (set lensRes . assertM (not . Text.null) <$> res, fvInput fieldView))
|
||||
<$> mopt textField "" (Just $ row ^. lensDefault)
|
||||
)
|
||||
|
||||
checkboxCell :: Ord i
|
||||
=> Lens' a Bool
|
||||
-> Getter (DBRow r) Bool
|
||||
-> Getter (DBRow r) i
|
||||
-> DBRow r
|
||||
-> DBCell (MForm (HandlerT UniWorX IO)) (FormResult (DBFormResult i a (DBRow r)))
|
||||
checkboxCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex)
|
||||
( \row _mkUnique -> (\(res, fieldView) -> (set lensRes <$> res, fvInput fieldView))
|
||||
<$> mpopt checkBoxField "" (Just $ row ^. lensDefault)
|
||||
)
|
||||
|
||||
|
||||
mkDegreeTable :: DB (FormResult (DBFormResult (Key StudyDegree) (Maybe Text, Maybe Text) (DBRow (Entity StudyDegree))), Widget)
|
||||
mkDegreeTable =
|
||||
let dbtIdent = "admin-studydegrees" :: Text
|
||||
dbtStyle = def
|
||||
dbtSQLQuery :: E.SqlExpr (Entity StudyDegree) -> E.SqlQuery ( E.SqlExpr (Entity StudyDegree))
|
||||
dbtSQLQuery :: E.SqlExpr (Entity StudyDegree) -> E.SqlQuery (E.SqlExpr (Entity StudyDegree))
|
||||
dbtSQLQuery = return
|
||||
dbtRowKey = (E.^. StudyDegreeKey)
|
||||
dbtProj = return
|
||||
dbtColonnade = formColonnade $ mconcat
|
||||
[ sortable (Just "key") (i18nCell MsgGenericKey) (numCell . view (_dbrOutput . _entityVal . _studyDegreeKey))
|
||||
, sortable (Just "name") (i18nCell MsgDegreeName) (textInputCell _1 (_dbrOutput . _entityVal . _studyDegreeName))
|
||||
, sortable (Just "short") (i18nCell MsgDegreeShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyDegreeShorthand))
|
||||
, sortable (Just "name") (i18nCell MsgDegreeName) (textInputCell _1 (_dbrOutput . _entityVal . _studyDegreeName) (_dbrOutput . _entityKey))
|
||||
, sortable (Just "short") (i18nCell MsgDegreeShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyDegreeShorthand) (_dbrOutput . _entityKey))
|
||||
, dbRow
|
||||
]
|
||||
dbtSorting = Map.fromList
|
||||
@ -392,20 +422,29 @@ postAdminFeaturesR = do
|
||||
dbtCsvDecode = Nothing
|
||||
in dbTable psValidator DBTable{..}
|
||||
|
||||
mkStudytermsTable :: Set (Key StudyTerms) -> Set (Key StudyTerms) -> DB (FormResult (DBFormResult (Key StudyTerms) (Maybe Text, Maybe Text) (DBRow (Entity StudyTerms))), Widget)
|
||||
mkStudytermsTable newKeys badKeys =
|
||||
mkStudytermsTable :: Set (Key StudyTerms) -> Set (Key StudyTerms) -> Set (Entity School) -> DB (FormResult (DBFormResult (Key StudyTerms) (Maybe Text, Maybe Text, Set SchoolId) (DBRow (Entity StudyTerms, Set SchoolId))), Widget)
|
||||
mkStudytermsTable newKeys badKeys schools =
|
||||
let dbtIdent = "admin-studyterms" :: Text
|
||||
dbtStyle = def
|
||||
dbtSQLQuery :: E.SqlExpr (Entity StudyTerms) -> E.SqlQuery ( E.SqlExpr (Entity StudyTerms))
|
||||
dbtSQLQuery :: E.SqlExpr (Entity StudyTerms) -> E.SqlQuery (E.SqlExpr (Entity StudyTerms))
|
||||
dbtSQLQuery = return
|
||||
dbtRowKey = (E.^. StudyTermsKey)
|
||||
dbtProj = return
|
||||
dbtProj field = do
|
||||
fieldSchools <- fmap (setOf $ folded . _Value) . lift . E.select . E.from $ \school -> do
|
||||
E.where_ . E.exists . E.from $ \schoolTerms ->
|
||||
E.where_ $ schoolTerms E.^. SchoolTermsSchool E.==. school E.^. SchoolId
|
||||
E.&&. schoolTerms E.^. SchoolTermsTerms E.==. E.val (field ^. _dbrOutput . _entityKey)
|
||||
E.where_ $ school E.^. SchoolShorthand `E.in_` E.valList (toListOf (folded . _entityKey . _SchoolId) schools)
|
||||
return $ school E.^. SchoolId
|
||||
return $ field & _dbrOutput %~ (, fieldSchools)
|
||||
dbtColonnade = formColonnade $ mconcat
|
||||
[ sortable (Just "key") (i18nCell MsgGenericKey) (numCell . view (_dbrOutput . _entityVal . _studyTermsKey))
|
||||
, sortable (Just "isnew") (i18nCell MsgGenericIsNew) (isNewCell . flip Set.member newKeys . view (_dbrOutput . _entityKey))
|
||||
, sortable (Just "isbad") (i18nCell MsgGenericHasConflict) (isBadCell . flip Set.member badKeys . view (_dbrOutput . _entityKey))
|
||||
, sortable (Just "name") (i18nCell MsgStudyTermsName) (textInputCell _1 (_dbrOutput . _entityVal . _studyTermsName))
|
||||
, sortable (Just "short") (i18nCell MsgStudyTermsShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyTermsShorthand))
|
||||
[ sortable (Just "key") (i18nCell MsgGenericKey) (numCell . view (_dbrOutput . _1 . _entityVal . _studyTermsKey))
|
||||
, sortable (Just "isnew") (i18nCell MsgGenericIsNew) (isNewCell . flip Set.member newKeys . view (_dbrOutput . _1 . _entityKey))
|
||||
, sortable (Just "isbad") (i18nCell MsgGenericHasConflict) (isBadCell . flip Set.member badKeys . view (_dbrOutput . _1 . _entityKey))
|
||||
, sortable (Just "name") (i18nCell MsgStudyTermsName) (textInputCell _1 (_dbrOutput . _1 . _entityVal . _studyTermsName) (_dbrOutput . _1 . _entityKey))
|
||||
, sortable (Just "short") (i18nCell MsgStudyTermsShort) (textInputCell _2 (_dbrOutput . _1 . _entityVal . _studyTermsShorthand) (_dbrOutput . _1 . _entityKey))
|
||||
, flip foldMap schools $ \(Entity ssh School{schoolName}) ->
|
||||
sortable Nothing (cell $ toWidget schoolName) (checkboxCell (_3 . at ssh . _Maybe) (_dbrOutput . _2 . at ssh . _Maybe) (_dbrOutput . _1 . _entityKey))
|
||||
, dbRow
|
||||
]
|
||||
dbtSorting = Map.fromList
|
||||
|
||||
9
src/Handler/Allocation.hs
Normal file
9
src/Handler/Allocation.hs
Normal file
@ -0,0 +1,9 @@
|
||||
module Handler.Allocation
|
||||
( module Handler.Allocation
|
||||
) where
|
||||
|
||||
import Handler.Allocation.Info as Handler.Allocation
|
||||
import Handler.Allocation.Show as Handler.Allocation
|
||||
import Handler.Allocation.Application as Handler.Allocation
|
||||
import Handler.Allocation.Register as Handler.Allocation
|
||||
import Handler.Allocation.List as Handler.Allocation
|
||||
410
src/Handler/Allocation/Application.hs
Normal file
410
src/Handler/Allocation/Application.hs
Normal file
@ -0,0 +1,410 @@
|
||||
module Handler.Allocation.Application
|
||||
( AllocationApplicationButton(..)
|
||||
, ApplicationFormView(..)
|
||||
, ApplicationForm(..)
|
||||
, ApplicationFormMode(..)
|
||||
, ApplicationFormException(..)
|
||||
, applicationForm, editApplicationR
|
||||
, postAApplyR
|
||||
) where
|
||||
|
||||
import Import hiding (hash)
|
||||
|
||||
import Handler.Utils
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
import Crypto.Hash (hash)
|
||||
|
||||
import Control.Monad.Trans.State (execStateT)
|
||||
import Control.Monad.State.Class (modify)
|
||||
|
||||
|
||||
data AllocationApplicationButton = BtnAllocationApply
|
||||
| BtnAllocationApplicationEdit
|
||||
| BtnAllocationApplicationRetract
|
||||
| BtnAllocationApplicationRate
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Universe AllocationApplicationButton
|
||||
instance Finite AllocationApplicationButton
|
||||
|
||||
nullaryPathPiece ''AllocationApplicationButton $ camelToPathPiece' 1
|
||||
embedRenderMessage ''UniWorX ''AllocationApplicationButton id
|
||||
makePrisms ''AllocationApplicationButton
|
||||
|
||||
instance Button UniWorX AllocationApplicationButton where
|
||||
btnClasses BtnAllocationApplicationRetract = [BCIsButton, BCDanger]
|
||||
btnClasses _ = [BCIsButton, BCPrimary]
|
||||
|
||||
|
||||
data ApplicationFormView = ApplicationFormView
|
||||
{ afvPriority :: Maybe (FieldView UniWorX)
|
||||
, afvForm :: [FieldView UniWorX]
|
||||
, afvButtons :: ([AllocationApplicationButton], Widget)
|
||||
}
|
||||
|
||||
data ApplicationForm = ApplicationForm
|
||||
{ afPriority :: Maybe Natural
|
||||
, afField :: Maybe StudyFeaturesId
|
||||
, afText :: Maybe Text
|
||||
, afFiles :: Maybe (Source Handler File)
|
||||
, afRatingVeto :: Bool
|
||||
, afRatingPoints :: Maybe ExamGrade
|
||||
, afRatingComment :: Maybe Text
|
||||
, afAction :: AllocationApplicationButton
|
||||
}
|
||||
|
||||
data ApplicationFormMode = ApplicationFormMode
|
||||
{ afmApplicant :: Bool -- ^ Show priority
|
||||
, afmApplicantEdit :: Bool -- ^ Allow editing text, files, priority (if shown)
|
||||
, afmLecturer :: Bool -- ^ Allow editing rating
|
||||
}
|
||||
|
||||
|
||||
data ApplicationFormException = ApplicationFormNoApplication -- ^ Could not fill forced fields of application form with data from application
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
instance Exception ApplicationFormException
|
||||
|
||||
applicationForm :: (Maybe AllocationId)
|
||||
-> CourseId
|
||||
-> UserId
|
||||
-> ApplicationFormMode -- ^ Which parts of the shared form to display
|
||||
-> Html -> MForm Handler (FormResult ApplicationForm, ApplicationFormView)
|
||||
applicationForm maId@(is _Just -> isAlloc) cid uid ApplicationFormMode{..} csrf = do
|
||||
|
||||
(mApp, coursesNum, Course{..}, maxPrio) <- liftHandlerT . runDB $ do
|
||||
mApplication <- listToMaybe <$> selectList [CourseApplicationAllocation ==. maId, CourseApplicationUser ==. uid, CourseApplicationCourse ==. cid] [LimitTo 1]
|
||||
coursesNum <- fromIntegral . fromMaybe 1 <$> for maId (\aId -> count [AllocationCourseAllocation ==. aId])
|
||||
course <- getJust cid
|
||||
[E.Value (fromMaybe 0 -> maxPrio)] <- E.select . E.from $ \courseApplication -> do
|
||||
E.where_ $ courseApplication E.^. CourseApplicationCourse E.==. E.val cid
|
||||
E.&&. courseApplication E.^. CourseApplicationUser E.==. E.val uid
|
||||
E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.val maId
|
||||
E.&&. E.not_ (E.isNothing $ courseApplication E.^. CourseApplicationAllocationPriority)
|
||||
return . E.joinV . E.max_ $ courseApplication E.^. CourseApplicationAllocationPriority
|
||||
return (mApplication, coursesNum, course, maxPrio)
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
|
||||
let
|
||||
oldPrio :: Maybe Natural
|
||||
oldPrio = mApp >>= courseApplicationAllocationPriority . entityVal
|
||||
|
||||
coursesNum' = succ maxPrio `max` coursesNum
|
||||
|
||||
mkPrioOption :: Natural -> Option Natural
|
||||
mkPrioOption i = Option
|
||||
{ optionDisplay = mr . MsgAllocationCoursePriority $ coursesNum' - i
|
||||
, optionInternalValue = i
|
||||
, optionExternalValue = tshow i
|
||||
}
|
||||
|
||||
prioOptions :: OptionList Natural
|
||||
prioOptions = OptionList
|
||||
{ olOptions = sortOn (Down . optionInternalValue) . map mkPrioOption $ [0 .. pred coursesNum']
|
||||
, olReadExternal = readMay
|
||||
}
|
||||
prioField = selectField' (Just $ SomeMessage MsgAllocationCourseNoApplication) $ return prioOptions
|
||||
|
||||
(prioRes, prioView) <- case (isAlloc, afmApplicant, afmApplicantEdit, mApp) of
|
||||
(True , True , True , Nothing)
|
||||
-> over _2 Just <$> mopt prioField (fslI MsgApplicationPriority) (Just $ oldPrio)
|
||||
(True , True , True , Just _ )
|
||||
-> over (_1 . _FormSuccess) Just . over _2 Just <$> mreq prioField (fslI MsgApplicationPriority) oldPrio
|
||||
(True , True , False, _ )
|
||||
-> over _2 Just <$> mforcedOpt prioField (fslI MsgApplicationPriority) oldPrio
|
||||
(True , False, _ , Just _ )
|
||||
| is _Just oldPrio
|
||||
-> pure (FormSuccess oldPrio, Nothing)
|
||||
(True , _ , _ , _ )
|
||||
-> throwM ApplicationFormNoApplication
|
||||
(False, _ , _ , _ )
|
||||
-> pure (FormSuccess Nothing, Nothing)
|
||||
|
||||
(fieldRes, fieldView') <- if
|
||||
| afmApplicantEdit || afmLecturer
|
||||
-> mreq (studyFeaturesFieldFor Nothing False [] $ Just uid) (fslI MsgCourseStudyFeature & setTooltip MsgCourseStudyFeatureTip) (courseApplicationField . entityVal <$> mApp)
|
||||
| otherwise
|
||||
-> mforced (studyFeaturesFieldFor Nothing True (maybeToList $ mApp >>= courseApplicationField . entityVal) $ Just uid) (fslI MsgCourseStudyFeature & setTooltip MsgCourseStudyFeatureTip) (mApp >>= courseApplicationField . entityVal)
|
||||
|
||||
let textField' = convertField (Text.strip . unTextarea) Textarea textareaField
|
||||
textFs
|
||||
| is _Just courseApplicationsInstructions
|
||||
= fslI MsgCourseApplicationText & setTooltip MsgCourseApplicationFollowInstructions
|
||||
| otherwise
|
||||
= fslI MsgCourseApplicationText
|
||||
(textRes, textView) <- if
|
||||
| not courseApplicationsText
|
||||
-> pure (FormSuccess Nothing, Nothing)
|
||||
| not afmApplicantEdit
|
||||
-> over _2 Just <$> mforcedOpt textField' textFs (mApp >>= courseApplicationText . entityVal)
|
||||
| otherwise
|
||||
-> over _2 Just . over (_1 . _FormSuccess) (assertM $ not . Text.null) <$> mopt textField' textFs (Just $ mApp >>= courseApplicationText . entityVal)
|
||||
|
||||
hasFiles <- for mApp $ \(Entity appId _)
|
||||
-> fmap (not . null) . liftHandlerT . runDB $ selectKeysList [ CourseApplicationFileApplication ==. appId ] [ LimitTo 1 ]
|
||||
appCID <- for mApp $ encrypt . entityKey
|
||||
let appFilesInfo = (,) <$> hasFiles <*> appCID
|
||||
|
||||
filesLinkView <- if
|
||||
| fromMaybe False hasFiles || (isn't _NoUpload courseApplicationsFiles && not afmApplicantEdit)
|
||||
-> let filesLinkField = Field{..}
|
||||
where
|
||||
fieldParse _ _ = return $ Right Nothing
|
||||
fieldEnctype = mempty
|
||||
fieldView theId _ attrs _ _
|
||||
= [whamlet|
|
||||
$newline never
|
||||
$case appFilesInfo
|
||||
$of Just (True, appCID)
|
||||
<a ##{theId} *{attrs} href=@{CApplicationR courseTerm courseSchool courseShorthand appCID CAFilesR}>
|
||||
_{MsgCourseApplicationFiles}
|
||||
$of _
|
||||
<span ##{theId} *{attrs}>
|
||||
_{MsgCourseApplicationNoFiles}
|
||||
|]
|
||||
in Just . snd <$> mforced filesLinkField (fslI MsgCourseApplicationFiles) ()
|
||||
| otherwise
|
||||
-> return Nothing
|
||||
|
||||
filesWarningView <- if
|
||||
| fromMaybe False hasFiles && isn't _NoUpload courseApplicationsFiles && afmApplicantEdit
|
||||
-> fmap (Just . snd) . formMessage =<< messageIconI Info IconFileUpload MsgCourseApplicationFilesNeedReupload
|
||||
| otherwise
|
||||
-> return Nothing
|
||||
|
||||
(filesRes, filesView) <-
|
||||
let mkFs = bool MsgCourseApplicationFile MsgCourseApplicationArchive
|
||||
in if
|
||||
| not afmApplicantEdit || is _NoUpload courseApplicationsFiles
|
||||
-> return $ (FormSuccess Nothing, Nothing)
|
||||
| otherwise
|
||||
-> fmap (over _2 $ Just . ($ [])) . aFormToForm $ fileUploadForm False (fslI . mkFs) courseApplicationsFiles
|
||||
|
||||
(vetoRes, vetoView) <- if
|
||||
| afmLecturer
|
||||
-> over _2 Just <$> mpopt checkBoxField (fslI MsgApplicationVeto & setTooltip MsgApplicationVetoTip) (Just . fromMaybe False $ courseApplicationRatingVeto . entityVal <$> mApp)
|
||||
| otherwise
|
||||
-> return (FormSuccess . fromMaybe False $ courseApplicationRatingVeto . entityVal <$> mApp, Nothing)
|
||||
|
||||
(pointsRes, pointsView) <- if
|
||||
| afmLecturer
|
||||
-> over _2 Just <$> mopt examGradeField (fslI MsgApplicationRatingPoints & setTooltip MsgApplicationRatingPointsTip) (fmap Just $ mApp >>= courseApplicationRatingPoints . entityVal)
|
||||
| otherwise
|
||||
-> return (FormSuccess $ courseApplicationRatingPoints . entityVal =<< mApp, Nothing)
|
||||
|
||||
(commentRes, commentView) <- if
|
||||
| afmLecturer
|
||||
-> over _2 Just . over (_1 . _FormSuccess) (assertM $ not . Text.null) <$> mopt textField' (fslI MsgApplicationRatingComment & setTooltip (bool MsgApplicationRatingCommentInvisibleTip MsgApplicationRatingCommentVisibleTip courseApplicationsRatingsVisible)) (fmap Just $ mApp >>= courseApplicationRatingComment . entityVal)
|
||||
| otherwise
|
||||
-> return (FormSuccess $ courseApplicationRatingComment . entityVal =<< mApp, Nothing)
|
||||
|
||||
let
|
||||
buttons = catMaybes
|
||||
[ guardOn (not afmApplicantEdit && is _Just mApp && afmLecturer) BtnAllocationApplicationRate
|
||||
, guardOn ( afmApplicantEdit && is _Just mApp ) BtnAllocationApplicationEdit
|
||||
, guardOn ( afmApplicantEdit && is _Nothing mApp ) BtnAllocationApply
|
||||
, guardOn ( afmApplicantEdit && is _Just mApp ) BtnAllocationApplicationRetract
|
||||
]
|
||||
(actionRes, buttonsView) <- buttonForm' buttons csrf
|
||||
|
||||
ratingSection <- if
|
||||
| afmLecturer
|
||||
, afmApplicantEdit
|
||||
-> Just . set _fvTooltip (Just . toHtml $ mr MsgApplicationRatingSectionSelfTip) . snd <$> formSection MsgApplicationRatingSection
|
||||
| afmLecturer
|
||||
-> Just . snd <$> formSection MsgApplicationRatingSection
|
||||
| otherwise
|
||||
-> return Nothing
|
||||
|
||||
return ( ApplicationForm
|
||||
<$> prioRes
|
||||
<*> fieldRes
|
||||
<*> textRes
|
||||
<*> filesRes
|
||||
<*> vetoRes
|
||||
<*> pointsRes
|
||||
<*> commentRes
|
||||
<*> actionRes
|
||||
, ApplicationFormView
|
||||
{ afvPriority = prioView
|
||||
, afvForm = catMaybes $
|
||||
[ Just fieldView'
|
||||
, textView
|
||||
, filesLinkView
|
||||
, filesWarningView
|
||||
] ++ maybe [] (map Just) filesView ++
|
||||
[ ratingSection
|
||||
, vetoView
|
||||
, pointsView
|
||||
, commentView
|
||||
]
|
||||
, afvButtons = (buttons, buttonsView)
|
||||
}
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
editApplicationR :: Maybe AllocationId
|
||||
-> UserId
|
||||
-> CourseId
|
||||
-> Maybe CourseApplicationId
|
||||
-> ApplicationFormMode
|
||||
-> (AllocationApplicationButton -> Bool)
|
||||
-> SomeRoute UniWorX
|
||||
-> Handler (ApplicationFormView, Enctype)
|
||||
editApplicationR maId uid cid mAppId afMode allowAction postAction = do
|
||||
Course{..} <- runDB $ get404 cid
|
||||
|
||||
((appRes, appView), appEnc) <- runFormPost $ applicationForm maId cid uid afMode
|
||||
|
||||
formResult appRes $ \ApplicationForm{..} -> do
|
||||
if
|
||||
| BtnAllocationApply <- afAction
|
||||
, allowAction afAction
|
||||
-> runDB $ do
|
||||
haveOld <- exists [ CourseApplicationCourse ==. cid
|
||||
, CourseApplicationUser ==. uid
|
||||
, CourseApplicationAllocation ==. maId
|
||||
]
|
||||
when haveOld $
|
||||
invalidArgsI [MsgCourseApplicationExists]
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
let rated = afRatingVeto || is _Just afRatingPoints
|
||||
|
||||
appId <- insert CourseApplication
|
||||
{ courseApplicationCourse = cid
|
||||
, courseApplicationUser = uid
|
||||
, courseApplicationField = afField
|
||||
, courseApplicationText = afText
|
||||
, courseApplicationRatingVeto = afRatingVeto
|
||||
, courseApplicationRatingPoints = afRatingPoints
|
||||
, courseApplicationRatingComment = afRatingComment
|
||||
, courseApplicationAllocation = maId
|
||||
, courseApplicationAllocationPriority = afPriority
|
||||
, courseApplicationTime = now
|
||||
, courseApplicationRatingTime = guardOn rated now
|
||||
}
|
||||
let
|
||||
sinkFile' file = do
|
||||
fId <- insert file
|
||||
insert_ $ CourseApplicationFile appId fId
|
||||
forM_ afFiles $ \afFiles' ->
|
||||
runConduit $ transPipe liftHandlerT afFiles' .| C.mapM_ sinkFile'
|
||||
audit $ TransactionCourseApplicationEdit cid uid appId
|
||||
addMessageI Success $ MsgCourseApplicationCreated courseShorthand
|
||||
| is _BtnAllocationApplicationEdit afAction || is _BtnAllocationApplicationRate afAction
|
||||
, allowAction afAction
|
||||
, Just appId <- mAppId
|
||||
-> runDB $ do
|
||||
now <- liftIO getCurrentTime
|
||||
|
||||
changes <- if
|
||||
| afmApplicantEdit afMode -> do
|
||||
oldFiles <- Set.fromList . map (courseApplicationFileFile . entityVal) <$> selectList [CourseApplicationFileApplication ==. appId] []
|
||||
changes <- flip execStateT oldFiles . forM_ afFiles $ \afFiles' ->
|
||||
let sinkFile' file = do
|
||||
oldFiles' <- lift . E.select . E.from $ \(courseApplicationFile `E.InnerJoin` file') -> do
|
||||
E.on $ courseApplicationFile E.^. CourseApplicationFileFile E.==. file' E.^. FileId
|
||||
E.where_ $ file' E.^. FileTitle E.==. E.val (fileTitle file)
|
||||
E.&&. E.maybe
|
||||
(E.val . is _Nothing $ fileContent file)
|
||||
(\fc' -> maybe E.false (\fc -> E.sha256 fc' E.==. E.val (hash fc)) $ fileContent file)
|
||||
(file' E.^. FileContent)
|
||||
E.&&. file' E.^. FileId `E.in_` E.valList (Set.toList oldFiles)
|
||||
return $ file' E.^. FileId
|
||||
if
|
||||
| [E.Value oldFileId] <- oldFiles'
|
||||
-> modify $ Set.delete oldFileId
|
||||
| otherwise
|
||||
-> do
|
||||
fId <- lift $ insert file
|
||||
lift . insert_ $ CourseApplicationFile appId fId
|
||||
modify $ Set.insert fId
|
||||
in runConduit $ transPipe liftHandlerT afFiles' .| C.mapM_ sinkFile'
|
||||
deleteCascadeWhere [ FileId <-. Set.toList (oldFiles `Set.intersection` changes) ]
|
||||
return changes
|
||||
| otherwise
|
||||
-> return Set.empty
|
||||
|
||||
oldApp <- get404 appId
|
||||
let newApp = oldApp
|
||||
{ courseApplicationField = afField
|
||||
, courseApplicationText = afText
|
||||
, courseApplicationRatingVeto = afRatingVeto
|
||||
, courseApplicationRatingPoints = afRatingPoints
|
||||
, courseApplicationRatingComment = afRatingComment
|
||||
, courseApplicationAllocation = maId
|
||||
, courseApplicationAllocationPriority = afPriority
|
||||
}
|
||||
|
||||
newRating = any (\f -> f oldApp newApp)
|
||||
[ (/=) `on` courseApplicationRatingVeto
|
||||
, (/=) `on` courseApplicationRatingPoints
|
||||
, (/=) `on` courseApplicationRatingComment
|
||||
]
|
||||
hasRating = any ($ newApp)
|
||||
[ courseApplicationRatingVeto
|
||||
, is _Just . courseApplicationRatingPoints
|
||||
]
|
||||
|
||||
appChanged = any (\f -> f oldApp newApp)
|
||||
[ (/=) `on` courseApplicationField
|
||||
, (/=) `on` courseApplicationText
|
||||
, \_ _ -> not $ Set.null changes
|
||||
]
|
||||
|
||||
newApp' = newApp
|
||||
& bool id (set _courseApplicationRatingTime Nothing) appChanged
|
||||
& bool id (set _courseApplicationRatingTime $ Just now) (newRating && hasRating)
|
||||
& bool id (set _courseApplicationTime now) appChanged
|
||||
replace appId newApp'
|
||||
audit $ TransactionCourseApplicationEdit cid uid appId
|
||||
|
||||
uncurry addMessageI =<< case (afmLecturer afMode, newRating, hasRating, appChanged) of
|
||||
(_, False, _, True) -> return (Success, MsgCourseApplicationEdited courseShorthand)
|
||||
(_, False, _, False) -> return (Info, MsgCourseApplicationNotEdited courseShorthand)
|
||||
(True, True, True, _) -> return (Success, MsgCourseApplicationRated)
|
||||
(True, True, False, _) -> return (Success, MsgCourseApplicationRatingDeleted)
|
||||
(False, True, _, _) -> permissionDenied "rating changed without lecturer rights"
|
||||
| is _BtnAllocationApplicationRetract afAction
|
||||
, allowAction afAction
|
||||
, Just appId <- mAppId
|
||||
-> runDB $ do
|
||||
deleteCascade appId
|
||||
audit $ TransactionCourseApplicationDeleted cid uid appId
|
||||
addMessageI Success $ MsgCourseApplicationDeleted courseShorthand
|
||||
| otherwise
|
||||
-> invalidArgsI [MsgCourseApplicationInvalidAction]
|
||||
|
||||
redirect postAction
|
||||
|
||||
return (appView, appEnc)
|
||||
|
||||
|
||||
postAApplyR :: TermId -> SchoolId -> AllocationShorthand -> CryptoUUIDCourse -> Handler Void
|
||||
postAApplyR tid ssh ash cID = do
|
||||
uid <- requireAuthId
|
||||
cid <- decrypt cID
|
||||
(aId, Course{..}) <- runDB $ do
|
||||
aId <- getKeyBy404 $ TermSchoolAllocationShort tid ssh ash
|
||||
course <- get404 cid
|
||||
return (aId, course)
|
||||
|
||||
afmLecturer <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
|
||||
|
||||
let afMode = ApplicationFormMode
|
||||
{ afmApplicant = True
|
||||
, afmApplicantEdit = True
|
||||
, afmLecturer
|
||||
}
|
||||
|
||||
void . editApplicationR (Just aId) uid cid Nothing afMode (== BtnAllocationApply) . SomeRoute $ AllocationR tid ssh ash AShowR :#: cID
|
||||
|
||||
invalidArgs ["Application form required"]
|
||||
13
src/Handler/Allocation/Info.hs
Normal file
13
src/Handler/Allocation/Info.hs
Normal file
@ -0,0 +1,13 @@
|
||||
module Handler.Allocation.Info
|
||||
( getInfoAllocationR
|
||||
) where
|
||||
|
||||
import Import
|
||||
import Handler.Utils
|
||||
|
||||
|
||||
getInfoAllocationR :: Handler Html
|
||||
getInfoAllocationR =
|
||||
siteLayoutMsg MsgMenuAllocationInfo $ do
|
||||
setTitleI MsgMenuAllocationInfo
|
||||
$(i18nWidgetFile "allocation-info")
|
||||
89
src/Handler/Allocation/List.hs
Normal file
89
src/Handler/Allocation/List.hs
Normal file
@ -0,0 +1,89 @@
|
||||
module Handler.Allocation.List
|
||||
( getAllocationListR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
import Handler.Utils.Table.Columns
|
||||
import Handler.Utils.Table.Pagination
|
||||
|
||||
|
||||
type AllocationTableExpr = E.SqlExpr (Entity Allocation)
|
||||
type AllocationTableData = DBRow (Entity Allocation)
|
||||
|
||||
allocationListIdent :: Text
|
||||
allocationListIdent = "allocations"
|
||||
|
||||
queryAllocation :: Getter AllocationTableExpr (E.SqlExpr (Entity Allocation))
|
||||
queryAllocation = id
|
||||
|
||||
resultAllocation :: Lens' AllocationTableData (Entity Allocation)
|
||||
resultAllocation = _dbrOutput
|
||||
|
||||
allocationTermLink :: TermId -> SomeRoute UniWorX
|
||||
allocationTermLink tid = SomeRoute (AllocationListR, [(dbFilterKey allocationListIdent "term", toPathPiece tid)])
|
||||
|
||||
allocationSchoolLink :: SchoolId -> SomeRoute UniWorX
|
||||
allocationSchoolLink ssh = SomeRoute (AllocationListR, [(dbFilterKey allocationListIdent "school", toPathPiece ssh)])
|
||||
|
||||
allocationLink :: Allocation -> SomeRoute UniWorX
|
||||
allocationLink Allocation{..} = SomeRoute $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR
|
||||
|
||||
getAllocationListR :: Handler Html
|
||||
getAllocationListR = do
|
||||
now <- liftIO getCurrentTime
|
||||
let
|
||||
dbtSQLQuery :: AllocationTableExpr -> E.SqlQuery _
|
||||
dbtSQLQuery = return
|
||||
|
||||
dbtProj :: DBRow _ -> MaybeT (YesodDB UniWorX) AllocationTableData
|
||||
dbtProj = return
|
||||
|
||||
dbtRowKey = view $ queryAllocation . to (E.^. AllocationId)
|
||||
|
||||
dbtColonnade :: Colonnade Sortable _ _
|
||||
dbtColonnade = mconcat
|
||||
[ anchorColonnade (views (resultAllocation . _entityVal . _allocationTerm) allocationTermLink) $ colTermShort (resultAllocation . _entityVal . _allocationTerm)
|
||||
, anchorColonnade (views (resultAllocation . _entityVal . _allocationSchool) allocationSchoolLink) $ colSchoolShort (resultAllocation . _entityVal . _allocationSchool)
|
||||
, anchorColonnade (views (resultAllocation . _entityVal) allocationLink) $ colAllocationName (resultAllocation . _entityVal . _allocationName)
|
||||
]
|
||||
|
||||
dbtSorting = mconcat
|
||||
[ sortTerm $ queryAllocation . to (E.^. AllocationTerm)
|
||||
, sortSchool $ queryAllocation . to (E.^. AllocationSchool)
|
||||
, sortAllocationName $ queryAllocation . to (E.^. AllocationName)
|
||||
]
|
||||
|
||||
dbtFilter = mconcat
|
||||
[ fltrAllocationActive now queryAllocation
|
||||
, fltrTerm $ queryAllocation . to (E.^. AllocationTerm)
|
||||
, fltrSchool $ queryAllocation . to (E.^. AllocationSchool)
|
||||
, fltrAllocation queryAllocation
|
||||
]
|
||||
dbtFilterUI = mconcat
|
||||
[ fltrAllocationActiveUI
|
||||
, fltrTermUI
|
||||
, fltrSchoolUI
|
||||
, fltrAllocationUI
|
||||
]
|
||||
|
||||
dbtStyle = def
|
||||
{ dbsFilterLayout = defaultDBSFilterLayout
|
||||
}
|
||||
dbtParams = def
|
||||
|
||||
dbtCsvEncode = noCsvEncode
|
||||
dbtCsvDecode = Nothing
|
||||
|
||||
dbtIdent = allocationListIdent
|
||||
|
||||
psValidator :: PSValidator _ _
|
||||
psValidator = def
|
||||
& defaultSorting [SortDescBy "term", SortAscBy "school", SortAscBy "allocation"]
|
||||
|
||||
table <- runDB $ dbTableWidget' psValidator DBTable{..}
|
||||
|
||||
siteLayoutMsg MsgAllocationListTitle $ do
|
||||
setTitleI MsgAllocationListTitle
|
||||
table
|
||||
60
src/Handler/Allocation/Register.hs
Normal file
60
src/Handler/Allocation/Register.hs
Normal file
@ -0,0 +1,60 @@
|
||||
module Handler.Allocation.Register
|
||||
( AllocationRegisterForm(..)
|
||||
, AllocationRegisterButton(..)
|
||||
, allocationRegisterForm
|
||||
, allocationUserToForm
|
||||
, postARegisterR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils.Form
|
||||
|
||||
{-# ANN module ("HLint: ignore Use newtype instead of data"::String) #-}
|
||||
|
||||
|
||||
data AllocationRegisterForm = AllocationRegisterForm
|
||||
{ arfTotalCourses :: Natural
|
||||
}
|
||||
|
||||
allocationRegisterForm :: Maybe AllocationRegisterForm -> AForm Handler AllocationRegisterForm
|
||||
allocationRegisterForm template
|
||||
= AllocationRegisterForm
|
||||
<$> areq (posIntFieldI MsgAllocationTotalCoursesNegative) (fslI MsgAllocationTotalCourses & setTooltip MsgAllocationTotalCoursesTip) (arfTotalCourses <$> template <|> Just 1)
|
||||
|
||||
allocationUserToForm :: AllocationUser -> AllocationRegisterForm
|
||||
allocationUserToForm AllocationUser{..} = AllocationRegisterForm
|
||||
{ arfTotalCourses = allocationUserTotalCourses
|
||||
}
|
||||
|
||||
data AllocationRegisterButton = BtnAllocationRegister | BtnAllocationRegistrationEdit
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Universe AllocationRegisterButton
|
||||
instance Finite AllocationRegisterButton
|
||||
|
||||
nullaryPathPiece ''AllocationRegisterButton $ camelToPathPiece' 1
|
||||
embedRenderMessage ''UniWorX ''AllocationRegisterButton id
|
||||
|
||||
instance Button UniWorX AllocationRegisterButton where
|
||||
btnClasses _ = [BCIsButton, BCPrimary]
|
||||
|
||||
postARegisterR :: TermId -> SchoolId -> AllocationShorthand -> Handler Void
|
||||
postARegisterR tid ssh ash = do
|
||||
uid <- requireAuthId
|
||||
|
||||
((registerRes, _), _) <- runFormPost . renderAForm FormStandard $ allocationRegisterForm Nothing
|
||||
formResult registerRes $ \AllocationRegisterForm{..} -> runDB $ do
|
||||
aId <- getKeyBy404 $ TermSchoolAllocationShort tid ssh ash
|
||||
isRegistered <- existsBy $ UniqueAllocationUser aId uid
|
||||
void $ upsert AllocationUser
|
||||
{ allocationUserAllocation = aId
|
||||
, allocationUserUser = uid
|
||||
, allocationUserTotalCourses = arfTotalCourses
|
||||
}
|
||||
[ AllocationUserTotalCourses =. arfTotalCourses
|
||||
]
|
||||
if
|
||||
| isRegistered -> addMessageI Success MsgAllocationRegistrationEdited
|
||||
| otherwise -> addMessageI Success MsgAllocationRegistered
|
||||
|
||||
redirect $ AllocationR tid ssh ash AShowR :#: ("allocation-participation" :: Text)
|
||||
99
src/Handler/Allocation/Show.hs
Normal file
99
src/Handler/Allocation/Show.hs
Normal file
@ -0,0 +1,99 @@
|
||||
module Handler.Allocation.Show
|
||||
( getAShowR
|
||||
) where
|
||||
|
||||
import Import
|
||||
import Handler.Utils
|
||||
|
||||
import Handler.Allocation.Register
|
||||
import Handler.Allocation.Application
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
|
||||
|
||||
getAShowR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
|
||||
getAShowR tid ssh ash = do
|
||||
muid <- maybeAuthId
|
||||
now <- liftIO getCurrentTime
|
||||
|
||||
let
|
||||
resultCourse :: Simple Field1 a (Entity Course) => Lens' a (Entity Course)
|
||||
resultCourse = _1
|
||||
resultCourseApplication :: Simple Field2 a (Maybe (Entity CourseApplication)) => Traversal' a (Entity CourseApplication)
|
||||
resultCourseApplication = _2 . _Just
|
||||
resultHasTemplate :: Simple Field3 a (E.Value Bool) => Lens' a Bool
|
||||
resultHasTemplate = _3 . _Value
|
||||
|
||||
(Entity aId Allocation{..}, courses, registration) <- runDB $ do
|
||||
alloc@(Entity aId _) <- getBy404 $ TermSchoolAllocationShort tid ssh ash
|
||||
|
||||
courses <- E.select . E.from $ \((allocationCourse `E.InnerJoin` course) `E.LeftOuterJoin` courseApplication) -> do
|
||||
E.on $ courseApplication E.?. CourseApplicationCourse E.==. E.just (course E.^. CourseId)
|
||||
E.&&. courseApplication E.?. CourseApplicationUser E.==. E.val muid
|
||||
E.&&. courseApplication E.?. CourseApplicationAllocation E.==. E.just (E.just $ E.val aId)
|
||||
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
|
||||
E.orderBy [E.asc $ course E.^. CourseName]
|
||||
let hasTemplate = E.exists . E.from $ \courseAppInstructionFile ->
|
||||
E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. course E.^. CourseId
|
||||
return (course, courseApplication, hasTemplate)
|
||||
|
||||
registration <- fmap join . for muid $ getBy . UniqueAllocationUser aId
|
||||
|
||||
return (alloc, nubOn (view $ resultCourse . _entityKey) courses, registration)
|
||||
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
let title = MsgAllocationTitle (mr . ShortTermIdentifier $ unTermKey allocationTerm) (unSchoolKey allocationSchool) allocationName
|
||||
shortTitle = MsgAllocationShortTitle (mr . ShortTermIdentifier $ unTermKey allocationTerm) (unSchoolKey allocationSchool) allocationShorthand
|
||||
|
||||
-- staffInformation <- anyM courses $ \(view $ resultCourse . _entityVal -> Course{..}) ->
|
||||
-- hasReadAccessTo $ CourseR courseTerm courseSchool courseShorthand CApplicationsR
|
||||
mayRegister <- hasWriteAccessTo $ AllocationR tid ssh ash ARegisterR
|
||||
(registerForm, registerEnctype) <- generateFormPost . renderAForm FormStandard . allocationRegisterForm $ allocationUserToForm . entityVal <$> registration
|
||||
let
|
||||
registerBtn = bool BtnAllocationRegister BtnAllocationRegistrationEdit $ is _Just registration
|
||||
registerForm' = wrapForm' registerBtn registerForm FormSettings
|
||||
{ formMethod = POST
|
||||
, formAction = Just . SomeRoute $ AllocationR tid ssh ash ARegisterR
|
||||
, formEncoding = registerEnctype
|
||||
, formAttrs = []
|
||||
, formSubmit = FormSubmit
|
||||
, formAnchor = Nothing :: Maybe Text
|
||||
}
|
||||
|
||||
siteLayoutMsg title $ do
|
||||
setTitleI shortTitle
|
||||
|
||||
let courseWidgets = flip map courses $ \cEntry -> do
|
||||
let Entity cid Course{..} = cEntry ^. resultCourse
|
||||
hasApplicationTemplate = cEntry ^. resultHasTemplate
|
||||
mApp = cEntry ^? resultCourseApplication
|
||||
cID <- encrypt cid :: WidgetT UniWorX IO CryptoUUIDCourse
|
||||
mayApply <- hasWriteAccessTo . AllocationR tid ssh ash $ AApplyR cID
|
||||
isLecturer <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
|
||||
mApplyFormView <- liftHandlerT . for muid $ \uid -> generateFormPost . applicationForm (Just aId) cid uid $ ApplicationFormMode True mayApply isLecturer
|
||||
tRoute <- case mApp of
|
||||
Nothing -> return . AllocationR tid ssh ash $ AApplyR cID
|
||||
Just (Entity appId _) -> CApplicationR courseTerm courseSchool courseShorthand <$> encrypt appId <*> pure CAEditR
|
||||
let mApplyFormView' = view _1 <$> mApplyFormView
|
||||
overrideVisible = not mayApply && is _Just mApp
|
||||
case mApplyFormView of
|
||||
Just (_, appFormEnctype)
|
||||
-> wrapForm $(widgetFile "allocation/show/course") FormSettings
|
||||
{ formMethod = POST
|
||||
, formAction = Just $ SomeRoute tRoute
|
||||
, formEncoding = appFormEnctype
|
||||
, formAttrs = [ ("class", "allocation-course")
|
||||
]
|
||||
, formSubmit = FormNoSubmit
|
||||
, formAnchor = Just cID
|
||||
}
|
||||
Nothing
|
||||
-> let wdgt = $(widgetFile "allocation/show/course")
|
||||
in [whamlet|
|
||||
<div .allocation-course ##{toPathPiece cID}>
|
||||
^{wdgt}
|
||||
|]
|
||||
let daysToRegistrationStart = assertM (>0) $ (`diffUTCTime` now) <$> allocationRegisterFrom
|
||||
allocationInfoModal = modal [whamlet|_{MsgMenuAllocationInfo}|] $ Left $ SomeRoute InfoAllocationR
|
||||
$(widgetFile "allocation/show")
|
||||
@ -12,8 +12,6 @@ import Handler.Utils.SheetType
|
||||
import Handler.Utils.Delete
|
||||
-- import Handler.Utils.Zip
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import Data.List as List (nub, foldl, foldr)
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
|
||||
@ -1,37 +1,7 @@
|
||||
module Handler.Course.Application
|
||||
( getCAFilesR
|
||||
( module Handler.Course.Application
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
|
||||
import System.FilePath (addExtension)
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
|
||||
getCAFilesR :: TermId -> SchoolId -> CourseShorthand -> CryptoFileNameCourseApplication -> Handler TypedContent
|
||||
getCAFilesR tid ssh csh cID = do
|
||||
appId <- decrypt cID
|
||||
User{..} <- runDB $ do
|
||||
CourseApplication{..} <- get404 appId
|
||||
Course{..} <- get404 courseApplicationCourse
|
||||
let matches = and
|
||||
[ tid == courseTerm
|
||||
, ssh == courseSchool
|
||||
, csh == courseShorthand
|
||||
]
|
||||
unless matches . redirectWith movedPermanently301 $ CApplicationR courseTerm courseSchool courseShorthand cID CAFilesR
|
||||
get404 courseApplicationUser
|
||||
|
||||
archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $ MsgCourseApplicationArchiveName tid ssh csh cID userDisplayName
|
||||
let
|
||||
fsSource = E.selectSource . E.from $ \(courseApplicationFile `E.InnerJoin` file) -> do
|
||||
E.on $ courseApplicationFile E.^. CourseApplicationFileFile E.==. file E.^. FileId
|
||||
E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. E.val appId
|
||||
return file
|
||||
|
||||
serveSomeFiles archiveName $ fsSource .| C.map entityVal
|
||||
import Handler.Course.Application.List as Handler.Course.Application
|
||||
import Handler.Course.Application.Files as Handler.Course.Application
|
||||
import Handler.Course.Application.Edit as Handler.Course.Application
|
||||
|
||||
55
src/Handler/Course/Application/Edit.hs
Normal file
55
src/Handler/Course/Application/Edit.hs
Normal file
@ -0,0 +1,55 @@
|
||||
module Handler.Course.Application.Edit
|
||||
( getCAEditR, postCAEditR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils
|
||||
import Handler.Allocation.Application
|
||||
|
||||
|
||||
getCAEditR, postCAEditR :: TermId -> SchoolId -> CourseShorthand -> CryptoFileNameCourseApplication -> Handler Html
|
||||
getCAEditR = postCAEditR
|
||||
postCAEditR tid ssh csh cID = do
|
||||
uid <- requireAuthId
|
||||
appId <- decrypt cID
|
||||
(mAlloc, Entity cid Course{..}, CourseApplication{..}, isAdmin, User{..}) <- runDB $ do
|
||||
course <- getBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
app <- get404 appId
|
||||
mAlloc <- traverse getEntity404 $ courseApplicationAllocation app
|
||||
appUser <- get404 $ courseApplicationUser app
|
||||
isAdmin <- case mAlloc of
|
||||
Just alloc -> exists [UserFunctionUser ==. uid, UserFunctionSchool ==. alloc ^. _entityVal . _allocationSchool, UserFunctionFunction ==. SchoolAdmin]
|
||||
Nothing -> exists [UserFunctionUser ==. uid, UserFunctionSchool ==. course ^. _entityVal . _courseSchool, UserFunctionFunction ==. SchoolAdmin]
|
||||
return (mAlloc, course, app, isAdmin, appUser)
|
||||
|
||||
afmLecturer <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
|
||||
afmApplicantEdit <- hasWriteAccessTo $ CApplicationR tid ssh csh cID CAEditR
|
||||
courseCID <- encrypt cid :: Handler CryptoUUIDCourse
|
||||
|
||||
let afMode = ApplicationFormMode
|
||||
{ afmApplicant = uid == courseApplicationUser || isAdmin
|
||||
, afmApplicantEdit
|
||||
, afmLecturer
|
||||
}
|
||||
|
||||
(ApplicationFormView{..}, appEnc) <- editApplicationR (entityKey <$> mAlloc) uid cid (Just appId) afMode (/= BtnAllocationApply) $ if
|
||||
| uid == courseApplicationUser
|
||||
, Just (Entity _ Allocation{..}) <- mAlloc
|
||||
-> SomeRoute $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR :#: courseCID
|
||||
| otherwise
|
||||
-> SomeRoute $ CApplicationR tid ssh csh cID CAEditR
|
||||
|
||||
let title = MsgCourseApplicationTitle userDisplayName courseShorthand
|
||||
|
||||
siteLayoutMsg title $ do
|
||||
setTitleI title
|
||||
|
||||
wrapForm ((<> snd afvButtons) . renderFieldViews FormStandard . maybe id (:) afvPriority$ afvForm) FormSettings
|
||||
{ formMethod = POST
|
||||
, formAction = Just . SomeRoute $ CApplicationR tid ssh csh cID CAEditR
|
||||
, formEncoding = appEnc
|
||||
, formAttrs = []
|
||||
, formSubmit = FormNoSubmit
|
||||
, formAnchor = Nothing :: Maybe Text
|
||||
}
|
||||
108
src/Handler/Course/Application/Files.hs
Normal file
108
src/Handler/Course/Application/Files.hs
Normal file
@ -0,0 +1,108 @@
|
||||
module Handler.Course.Application.Files
|
||||
( getCAFilesR
|
||||
, getCAppsFilesR
|
||||
) where
|
||||
|
||||
import Import
|
||||
import Handler.Utils
|
||||
|
||||
import System.FilePath (addExtension, (</>))
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
|
||||
getCAFilesR :: TermId -> SchoolId -> CourseShorthand -> CryptoFileNameCourseApplication -> Handler TypedContent
|
||||
getCAFilesR tid ssh csh cID = do
|
||||
appId <- decrypt cID
|
||||
User{..} <- runDB $ do
|
||||
CourseApplication{..} <- get404 appId
|
||||
Course{..} <- get404 courseApplicationCourse
|
||||
let matches = and
|
||||
[ tid == courseTerm
|
||||
, ssh == courseSchool
|
||||
, csh == courseShorthand
|
||||
]
|
||||
unless matches . redirectWith movedPermanently301 $ CApplicationR courseTerm courseSchool courseShorthand cID CAFilesR
|
||||
get404 courseApplicationUser
|
||||
|
||||
archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $ MsgCourseApplicationArchiveName tid ssh csh cID userDisplayName
|
||||
let
|
||||
fsSource = E.selectSource . E.from $ \(courseApplicationFile `E.InnerJoin` file) -> do
|
||||
E.on $ courseApplicationFile E.^. CourseApplicationFileFile E.==. file E.^. FileId
|
||||
E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. E.val appId
|
||||
return file
|
||||
|
||||
serveSomeFiles archiveName $ fsSource .| C.map entityVal
|
||||
|
||||
|
||||
getCAppsFilesR :: TermId -> SchoolId -> CourseShorthand -> Handler TypedContent
|
||||
getCAppsFilesR tid ssh csh = do
|
||||
runDB . existsBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
|
||||
archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $ MsgCourseAllApplicationsArchiveName tid ssh csh
|
||||
|
||||
let
|
||||
fsSource :: Source DB File
|
||||
fsSource = do
|
||||
apps <- lift . E.select . E.from $ \((course `E.InnerJoin` courseApplication `E.InnerJoin` user) `E.LeftOuterJoin` allocation) -> do
|
||||
E.on $ allocation E.?. AllocationId E.==. courseApplication E.^. CourseApplicationAllocation
|
||||
E.on $ user E.^. UserId E.==. courseApplication E.^. CourseApplicationUser
|
||||
E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
|
||||
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
|
||||
return (allocation, user, courseApplication)
|
||||
apps' <- flip filterM apps $ \(_, _, Entity appId _) -> do
|
||||
cID <- cachedByBinary appId $ encrypt appId
|
||||
hasReadAccessTo $ CApplicationR tid ssh csh cID CAFilesR
|
||||
let
|
||||
applicationAllocs = setOf (folded . _1) apps'
|
||||
|
||||
allocations = applicationAllocs ^.. folded . _Just . _entityVal . $(multifocusG 3) _allocationTerm _allocationSchool _allocationShorthand
|
||||
|
||||
allEqualOn :: Eq x => Getter _ x -> Bool
|
||||
allEqualOn l = maybe True (\x -> allOf (folded . l) (== x) allocations) (allocations ^? _head . l)
|
||||
|
||||
mkAllocationDir mbAlloc
|
||||
| not $ allEqualOn _1
|
||||
, Just Allocation{..} <- mbAlloc
|
||||
= (</>) $ unpack [st|#{CI.foldCase (termToText (unTermKey allocationTerm))}-#{CI.foldedCase (unSchoolKey allocationSchool)}-#{CI.foldedCase allocationShorthand}|]
|
||||
| not $ allEqualOn _2
|
||||
, Just Allocation{..} <- mbAlloc
|
||||
= (</>) $ unpack [st|#{CI.foldedCase (unSchoolKey allocationSchool)}-#{CI.foldedCase allocationShorthand}|]
|
||||
| not $ allEqualOn _3
|
||||
, Just Allocation{..} <- mbAlloc
|
||||
= (</>) . unpack $ CI.foldedCase allocationShorthand
|
||||
| Just Allocation{} <- mbAlloc
|
||||
, not $ all (is _Just) applicationAllocs
|
||||
= (</>) . unpack $ mr MsgCourseApplicationsAllocatedDirectory
|
||||
| Nothing <- mbAlloc
|
||||
, any (is _Just) applicationAllocs
|
||||
= (</>) . unpack $ mr MsgCourseApplicationsNotAllocatedDirectory
|
||||
| otherwise
|
||||
= id
|
||||
|
||||
forM_ apps' $ \(mbAlloc, Entity _ User{..}, Entity appId CourseApplication{..}) -> do
|
||||
cID <- cachedByBinary appId $ encrypt appId :: _ CryptoFileNameCourseApplication
|
||||
let mkAppDir = mkAllocationDir (entityVal <$> mbAlloc) . (</>) (unpack [st|#{CI.foldedCase $ ciphertext cID}-#{CI.foldCase userSurname}|])
|
||||
dirFiles = C.map $ over _fileTitle mkAppDir . entityVal
|
||||
fileEntitySource = E.selectSource . E.from $ \(courseApplicationFile `E.InnerJoin` file) -> do
|
||||
E.on $ courseApplicationFile E.^. CourseApplicationFileFile E.==. file E.^. FileId
|
||||
E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. E.val appId
|
||||
return file
|
||||
|
||||
yield File
|
||||
{ fileModified = courseApplicationTime
|
||||
, fileTitle = mkAppDir ""
|
||||
, fileContent = Nothing
|
||||
}
|
||||
|
||||
fileEntitySource .| dirFiles
|
||||
|
||||
|
||||
serveSomeFiles archiveName fsSource
|
||||
536
src/Handler/Course/Application/List.hs
Normal file
536
src/Handler/Course/Application/List.hs
Normal file
@ -0,0 +1,536 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
|
||||
module Handler.Course.Application.List
|
||||
( getCApplicationsR, postCApplicationsR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Table.Columns
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
import Database.Esqueleto.Utils.TH
|
||||
|
||||
import qualified Data.Csv as Csv
|
||||
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Lens as Text
|
||||
|
||||
import Data.CaseInsensitive (CI)
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
|
||||
type CourseApplicationsTableExpr = ( E.SqlExpr (Entity CourseApplication)
|
||||
`E.InnerJoin` E.SqlExpr (Entity User)
|
||||
)
|
||||
`E.LeftOuterJoin` E.SqlExpr (Maybe (Entity Allocation))
|
||||
`E.LeftOuterJoin` ( E.SqlExpr (Maybe (Entity StudyFeatures))
|
||||
`E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms))
|
||||
`E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree))
|
||||
)
|
||||
type CourseApplicationsTableData = DBRow ( Entity CourseApplication
|
||||
, Entity User
|
||||
, E.Value Bool -- hasFiles
|
||||
, Maybe (Entity Allocation)
|
||||
, Maybe (Entity StudyFeatures)
|
||||
, Maybe (Entity StudyTerms)
|
||||
, Maybe (Entity StudyDegree)
|
||||
)
|
||||
|
||||
courseApplicationsIdent :: Text
|
||||
courseApplicationsIdent = "applications"
|
||||
|
||||
queryCourseApplication :: Getter CourseApplicationsTableExpr (E.SqlExpr (Entity CourseApplication))
|
||||
queryCourseApplication = to $ $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
|
||||
|
||||
queryUser :: Getter CourseApplicationsTableExpr (E.SqlExpr (Entity User))
|
||||
queryUser = to $ $(sqlIJproj 2 2) . $(sqlLOJproj 3 1)
|
||||
|
||||
queryHasFiles :: Getter CourseApplicationsTableExpr (E.SqlExpr (E.Value Bool))
|
||||
queryHasFiles = to $ hasFiles . $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
|
||||
where
|
||||
hasFiles appl = E.exists . E.from $ \courseApplicationFile ->
|
||||
E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. appl E.^. CourseApplicationId
|
||||
|
||||
queryAllocation :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity Allocation)))
|
||||
queryAllocation = to $(sqlLOJproj 3 2)
|
||||
|
||||
queryStudyFeatures :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity StudyFeatures)))
|
||||
queryStudyFeatures = to $ $(sqlIJproj 3 1) . $(sqlLOJproj 3 3)
|
||||
|
||||
queryStudyTerms :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity StudyTerms)))
|
||||
queryStudyTerms = to $ $(sqlIJproj 3 2) . $(sqlLOJproj 3 3)
|
||||
|
||||
queryStudyDegree :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity StudyDegree)))
|
||||
queryStudyDegree = to $ $(sqlIJproj 3 3) . $(sqlLOJproj 3 3)
|
||||
|
||||
resultCourseApplication :: Lens' CourseApplicationsTableData (Entity CourseApplication)
|
||||
resultCourseApplication = _dbrOutput . _1
|
||||
|
||||
resultUser :: Lens' CourseApplicationsTableData (Entity User)
|
||||
resultUser = _dbrOutput . _2
|
||||
|
||||
resultHasFiles :: Lens' CourseApplicationsTableData Bool
|
||||
resultHasFiles = _dbrOutput . _3 . _Value
|
||||
|
||||
resultAllocation :: Traversal' CourseApplicationsTableData (Entity Allocation)
|
||||
resultAllocation = _dbrOutput . _4 . _Just
|
||||
|
||||
resultStudyFeatures :: Traversal' CourseApplicationsTableData (Entity StudyFeatures)
|
||||
resultStudyFeatures = _dbrOutput . _5 . _Just
|
||||
|
||||
resultStudyTerms :: Traversal' CourseApplicationsTableData (Entity StudyTerms)
|
||||
resultStudyTerms = _dbrOutput . _6 . _Just
|
||||
|
||||
resultStudyDegree :: Traversal' CourseApplicationsTableData (Entity StudyDegree)
|
||||
resultStudyDegree = _dbrOutput . _7 . _Just
|
||||
|
||||
|
||||
newtype CourseApplicationsTableVeto = CourseApplicationsTableVeto Bool
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
deriving newtype (Enum, Bounded)
|
||||
makePrisms ''CourseApplicationsTableVeto
|
||||
|
||||
instance Csv.ToField CourseApplicationsTableVeto where
|
||||
toField (CourseApplicationsTableVeto True) = "veto"
|
||||
toField (CourseApplicationsTableVeto False) = ""
|
||||
|
||||
instance Csv.FromField CourseApplicationsTableVeto where
|
||||
parseField f = do
|
||||
(CI.map Text.strip -> t :: CI Text) <- Csv.parseField f
|
||||
return . CourseApplicationsTableVeto $ any (== t)
|
||||
[ "veto", "v", "yes", "y", "ja", "j", "wahr", "w", "true", "t", "1" ]
|
||||
|
||||
data CourseApplicationsTableCsv = CourseApplicationsTableCsv
|
||||
{ csvCAAllocation :: Maybe AllocationShorthand
|
||||
, csvCAApplication :: Maybe CryptoFileNameCourseApplication
|
||||
, csvCAName :: Maybe Text
|
||||
, csvCAMatriculation :: Maybe Text
|
||||
, csvCAField :: Maybe Text
|
||||
, csvCADegree :: Maybe Text
|
||||
, csvCASemester :: Maybe Int
|
||||
, csvCAText :: Maybe Text
|
||||
, csvCAHasFiles :: Maybe Bool
|
||||
, csvCAVeto :: Maybe CourseApplicationsTableVeto
|
||||
, csvCARating :: Maybe ExamGrade
|
||||
, csvCAComment :: Maybe Text
|
||||
} deriving (Generic)
|
||||
makeLenses_ ''CourseApplicationsTableCsv
|
||||
|
||||
courseApplicationsTableCsvOptions :: Csv.Options
|
||||
courseApplicationsTableCsvOptions = Csv.defaultOptions { Csv.fieldLabelModifier = camelToPathPiece' 2 }
|
||||
|
||||
instance Csv.ToNamedRecord CourseApplicationsTableCsv where
|
||||
toNamedRecord = Csv.genericToNamedRecord courseApplicationsTableCsvOptions
|
||||
|
||||
instance Csv.FromNamedRecord CourseApplicationsTableCsv where
|
||||
parseNamedRecord csv
|
||||
= CourseApplicationsTableCsv
|
||||
<$> csv .:?? "allocation"
|
||||
<*> csv .:?? "application"
|
||||
<*> csv .:?? "name"
|
||||
<*> csv .:?? "matriculation"
|
||||
<*> csv .:?? "field"
|
||||
<*> csv .:?? "degree"
|
||||
<*> csv .:?? "semester"
|
||||
<*> csv .:?? "text"
|
||||
<*> csv .:?? "has-files"
|
||||
<*> csv .:?? "veto"
|
||||
<*> csv .:?? "rating"
|
||||
<*> csv .:?? "comment"
|
||||
|
||||
instance Csv.DefaultOrdered CourseApplicationsTableCsv where
|
||||
headerOrder = Csv.genericHeaderOrder courseApplicationsTableCsvOptions
|
||||
|
||||
instance CsvColumnsExplained CourseApplicationsTableCsv where
|
||||
csvColumnsExplanations = genericCsvColumnsExplanations courseApplicationsTableCsvOptions $ Map.fromList
|
||||
[ ('csvCAAllocation , MsgCsvColumnApplicationsAllocation )
|
||||
, ('csvCAApplication , MsgCsvColumnApplicationsApplication )
|
||||
, ('csvCAName , MsgCsvColumnApplicationsName )
|
||||
, ('csvCAMatriculation, MsgCsvColumnApplicationsMatriculation)
|
||||
, ('csvCAField , MsgCsvColumnApplicationsField )
|
||||
, ('csvCADegree , MsgCsvColumnApplicationsDegree )
|
||||
, ('csvCASemester , MsgCsvColumnApplicationsSemester )
|
||||
, ('csvCAText , MsgCsvColumnApplicationsText )
|
||||
, ('csvCAHasFiles , MsgCsvColumnApplicationsHasFiles )
|
||||
, ('csvCAVeto , MsgCsvColumnApplicationsVeto )
|
||||
, ('csvCARating , MsgCsvColumnApplicationsRating )
|
||||
, ('csvCAComment , MsgCsvColumnApplicationsComment )
|
||||
]
|
||||
|
||||
data CourseApplicationsTableCsvActionClass
|
||||
= CourseApplicationsTableCsvSetField
|
||||
| CourseApplicationsTableCsvSetVeto
|
||||
| CourseApplicationsTableCsvSetRating
|
||||
| CourseApplicationsTableCsvSetComment
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
embedRenderMessage ''UniWorX ''CourseApplicationsTableCsvActionClass id
|
||||
|
||||
data CourseApplicationsTableCsvAction
|
||||
= CourseApplicationsTableCsvSetFieldData
|
||||
{ caCsvActApplication :: CourseApplicationId
|
||||
, caCsvActField :: Maybe StudyFeaturesId
|
||||
}
|
||||
| CourseApplicationsTableCsvSetVetoData
|
||||
{ caCsvActApplication :: CourseApplicationId
|
||||
, caCsvActVeto :: Bool
|
||||
}
|
||||
| CourseApplicationsTableCsvSetRatingData
|
||||
{ caCsvActApplication :: CourseApplicationId
|
||||
, caCsvActRating :: Maybe ExamGrade
|
||||
}
|
||||
| CourseApplicationsTableCsvSetCommentData
|
||||
{ caCsvActApplication :: CourseApplicationId
|
||||
, caCsvActComment :: Maybe Text
|
||||
}
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
deriveJSON defaultOptions
|
||||
{ constructorTagModifier = over Text.packed $ Text.intercalate "-" . map Text.toLower . drop 4 . dropEnd 1 . splitCamel
|
||||
, fieldLabelModifier = camelToPathPiece' 3
|
||||
, sumEncoding = TaggedObject "action" "data"
|
||||
} ''CourseApplicationsTableCsvAction
|
||||
|
||||
data CourseApplicationsTableCsvException
|
||||
= CourseApplicationsTableCsvExceptionNoMatchingUser
|
||||
| CourseApplicationsTableCsvExceptionNoMatchingAllocation
|
||||
| CourseApplicationsTableCsvExceptionNoMatchingStudyFeatures
|
||||
deriving (Show, Generic, Typeable)
|
||||
|
||||
instance Exception CourseApplicationsTableCsvException
|
||||
|
||||
embedRenderMessage ''UniWorX ''CourseApplicationsTableCsvException id
|
||||
|
||||
|
||||
getCApplicationsR, postCApplicationsR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getCApplicationsR = postCApplicationsR
|
||||
postCApplicationsR tid ssh csh = do
|
||||
table <- runDB $ do
|
||||
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
|
||||
let
|
||||
allocationLink :: Allocation -> SomeRoute UniWorX
|
||||
allocationLink Allocation{..} = SomeRoute $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR
|
||||
|
||||
participantLink :: MonadCrypto m => UserId -> m (SomeRoute UniWorX)
|
||||
participantLink uid = do
|
||||
cID <- encrypt uid
|
||||
return . SomeRoute . CourseR tid ssh csh $ CUserR cID
|
||||
|
||||
dbtSQLQuery :: CourseApplicationsTableExpr -> E.SqlQuery _
|
||||
dbtSQLQuery = runReaderT $ do
|
||||
courseApplication <- view queryCourseApplication
|
||||
hasFiles <- view queryHasFiles
|
||||
user <- view queryUser
|
||||
allocation <- view queryAllocation
|
||||
studyFeatures <- view queryStudyFeatures
|
||||
studyTerms <- view queryStudyTerms
|
||||
studyDegree <- view queryStudyDegree
|
||||
|
||||
lift $ do
|
||||
E.on $ studyDegree E.?. StudyDegreeId E.==. studyFeatures E.?. StudyFeaturesDegree
|
||||
E.on $ studyTerms E.?. StudyTermsId E.==. studyFeatures E.?. StudyFeaturesField
|
||||
E.on $ studyFeatures E.?. StudyFeaturesId E.==. courseApplication E.^. CourseApplicationField
|
||||
E.on $ courseApplication E.^. CourseApplicationAllocation E.==. allocation E.?. AllocationId
|
||||
E.on $ user E.^. UserId E.==. courseApplication E.^. CourseApplicationUser
|
||||
E.where_ $ courseApplication E.^. CourseApplicationCourse E.==. E.val cid
|
||||
|
||||
return (courseApplication, user, hasFiles, allocation, studyFeatures, studyTerms, studyDegree)
|
||||
|
||||
dbtProj :: DBRow _ -> MaybeT (YesodDB UniWorX) CourseApplicationsTableData
|
||||
dbtProj = runReaderT $ do
|
||||
appId <- view $ resultCourseApplication . _entityKey
|
||||
cID <- encrypt appId
|
||||
|
||||
guardM . hasReadAccessTo $ CApplicationR tid ssh csh cID CAEditR
|
||||
|
||||
view id
|
||||
|
||||
dbtRowKey = view $ queryCourseApplication . to (E.^. CourseApplicationId)
|
||||
|
||||
dbtColonnade :: Colonnade Sortable _ _
|
||||
dbtColonnade = mconcat
|
||||
[ emptyOpticColonnade (resultAllocation . _entityVal) $ \l -> anchorColonnade (views l allocationLink) $ colAllocationShorthand (l . _allocationShorthand)
|
||||
, colApplicationId (resultCourseApplication . _entityKey)
|
||||
, anchorColonnadeM (views (resultUser . _entityKey) participantLink) $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname)
|
||||
, colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
|
||||
, emptyOpticColonnade (resultStudyTerms . _entityVal) colStudyTerms
|
||||
, emptyOpticColonnade (resultStudyDegree . _entityVal) colStudyDegree
|
||||
, emptyOpticColonnade (resultStudyFeatures . _entityVal . _studyFeaturesSemester) colStudyFeaturesSemester
|
||||
, colApplicationText (resultCourseApplication . _entityVal . _courseApplicationText)
|
||||
, lmap ((tid, ssh, csh), ) $ colApplicationFiles ($(multifocusL 5) (_1 . _1) (_1 . _2) (_1 . _3) (_2 . resultCourseApplication . _entityKey) (_2 . resultHasFiles))
|
||||
, colApplicationVeto (resultCourseApplication . _entityVal . _courseApplicationRatingVeto)
|
||||
, colApplicationRatingPoints (resultCourseApplication . _entityVal . _courseApplicationRatingPoints)
|
||||
, colApplicationRatingComment (resultCourseApplication . _entityVal . _courseApplicationRatingComment)
|
||||
]
|
||||
|
||||
dbtSorting = mconcat
|
||||
[ sortAllocationShorthand $ queryAllocation . to (E.?. AllocationShorthand)
|
||||
, sortUserName' $ $(multifocusG 2) (queryUser . to (E.^. UserDisplayName)) (queryUser . to (E.^. UserSurname))
|
||||
, sortUserMatriculation $ queryUser . to (E.^. UserMatrikelnummer)
|
||||
, sortStudyTerms queryStudyTerms
|
||||
, sortStudyDegree queryStudyDegree
|
||||
, sortStudyFeaturesSemester $ queryStudyFeatures . to (E.?. StudyFeaturesSemester)
|
||||
, sortApplicationText $ queryCourseApplication . to (E.^. CourseApplicationText)
|
||||
, sortApplicationFiles queryHasFiles
|
||||
, sortApplicationVeto $ queryCourseApplication . to (E.^. CourseApplicationRatingVeto)
|
||||
, sortApplicationRatingPoints $ queryCourseApplication . to (E.^. CourseApplicationRatingPoints)
|
||||
, sortApplicationRatingComment $ queryCourseApplication . to (E.^. CourseApplicationRatingComment)
|
||||
]
|
||||
|
||||
dbtFilter = mconcat
|
||||
[ fltrAllocation queryAllocation
|
||||
, fltrUserName' $ queryUser . to (E.^. UserDisplayName)
|
||||
, fltrUserMatriculation $ queryUser . to (E.^. UserMatrikelnummer)
|
||||
, fltrStudyTerms queryStudyTerms
|
||||
, fltrStudyDegree queryStudyDegree
|
||||
, fltrStudyFeaturesSemester $ queryStudyFeatures . to (E.?. StudyFeaturesSemester)
|
||||
, fltrApplicationText $ queryCourseApplication . to (E.^. CourseApplicationText)
|
||||
, fltrApplicationFiles queryHasFiles
|
||||
, fltrApplicationVeto $ queryCourseApplication . to (E.^. CourseApplicationRatingVeto)
|
||||
, fltrApplicationRatingPoints $ queryCourseApplication . to (E.^. CourseApplicationRatingPoints)
|
||||
, fltrApplicationRatingComment $ queryCourseApplication . to (E.^. CourseApplicationRatingComment)
|
||||
]
|
||||
dbtFilterUI = mconcat
|
||||
[ fltrAllocationUI
|
||||
, fltrUserNameUI'
|
||||
, fltrUserMatriculationUI
|
||||
, fltrStudyTermsUI
|
||||
, fltrStudyDegreeUI
|
||||
, fltrStudyFeaturesSemesterUI
|
||||
, fltrApplicationTextUI
|
||||
, fltrApplicationFilesUI
|
||||
, fltrApplicationVetoUI
|
||||
, fltrApplicationRatingPointsUI
|
||||
, fltrApplicationRatingCommentUI
|
||||
]
|
||||
|
||||
dbtStyle = def
|
||||
{ dbsFilterLayout = defaultDBSFilterLayout
|
||||
}
|
||||
dbtParams = def
|
||||
|
||||
dbtCsvEncode :: DBTCsvEncode CourseApplicationsTableData CourseApplicationsTableCsv
|
||||
dbtCsvEncode = DictJust . C.mapM . runReaderT $ CourseApplicationsTableCsv
|
||||
<$> preview (resultAllocation . _entityVal . _allocationShorthand)
|
||||
<*> (preview (resultCourseApplication . _entityKey) >>= traverse encrypt)
|
||||
<*> preview (resultUser . _entityVal . _userDisplayName)
|
||||
<*> preview (resultUser . _entityVal . _userMatrikelnummer . _Just)
|
||||
<*> preview (resultStudyTerms . _entityVal . (_studyTermsName . _Just <> _studyTermsShorthand . _Just <> to (tshow . studyTermsKey)))
|
||||
<*> preview (resultStudyDegree . _entityVal . (_studyDegreeName . _Just <> _studyDegreeShorthand . _Just <> to (tshow . studyDegreeKey)))
|
||||
<*> preview (resultStudyFeatures . _entityVal . _studyFeaturesSemester)
|
||||
<*> preview (resultCourseApplication . _entityVal . _courseApplicationText . _Just)
|
||||
<*> preview resultHasFiles
|
||||
<*> preview (resultCourseApplication . _entityVal . _courseApplicationRatingVeto . re _CourseApplicationsTableVeto)
|
||||
<*> preview (resultCourseApplication . _entityVal . _courseApplicationRatingPoints . _Just)
|
||||
<*> preview (resultCourseApplication . _entityVal . _courseApplicationRatingComment . _Just)
|
||||
dbtCsvDecode = Just DBTCsvDecode
|
||||
{ dbtCsvRowKey = \csv -> do
|
||||
appRes <- lift $ guessUser csv
|
||||
case appRes of
|
||||
Right appId -> return $ E.Value appId
|
||||
Left uid -> do
|
||||
alloc <- lift $ guessAllocation csv
|
||||
[appId] <- lift $ selectKeysList [CourseApplicationUser ==. uid, CourseApplicationAllocation ==. alloc] [LimitTo 2]
|
||||
return $ E.Value appId
|
||||
, dbtCsvComputeActions = \case
|
||||
DBCsvDiffMissing{}
|
||||
-> return () -- no deletion
|
||||
DBCsvDiffNew{}
|
||||
-> return () -- no addition
|
||||
DBCsvDiffExisting{..} -> do
|
||||
let appId = dbCsvOld ^. resultCourseApplication . _entityKey
|
||||
|
||||
newFeatures <- lift $ lookupStudyFeatures dbCsvNew
|
||||
when (newFeatures /= dbCsvOld ^? resultStudyFeatures . _entityKey) $
|
||||
yield $ CourseApplicationsTableCsvSetFieldData appId newFeatures
|
||||
|
||||
let mVeto = dbCsvNew ^? _csvCAVeto . _Just . _CourseApplicationsTableVeto
|
||||
whenIsJust mVeto $ \veto ->
|
||||
when (veto /= dbCsvOld ^. resultCourseApplication . _entityVal . _courseApplicationRatingVeto) $
|
||||
yield $ CourseApplicationsTableCsvSetVetoData appId veto
|
||||
|
||||
when (dbCsvNew ^. _csvCARating /= dbCsvOld ^. resultCourseApplication . _entityVal . _courseApplicationRatingPoints) $
|
||||
yield $ CourseApplicationsTableCsvSetRatingData appId (dbCsvNew ^. _csvCARating)
|
||||
|
||||
when (dbCsvNew ^. _csvCAComment /= dbCsvOld ^. resultCourseApplication . _entityVal . _courseApplicationRatingComment) $
|
||||
yield $ CourseApplicationsTableCsvSetCommentData appId (dbCsvNew ^. _csvCAComment)
|
||||
, dbtCsvClassifyAction = \case
|
||||
CourseApplicationsTableCsvSetFieldData{} -> CourseApplicationsTableCsvSetField
|
||||
CourseApplicationsTableCsvSetVetoData{} -> CourseApplicationsTableCsvSetVeto
|
||||
CourseApplicationsTableCsvSetRatingData{} -> CourseApplicationsTableCsvSetRating
|
||||
CourseApplicationsTableCsvSetCommentData{} -> CourseApplicationsTableCsvSetComment
|
||||
, dbtCsvCoarsenActionClass = const DBCsvActionExisting
|
||||
, dbtCsvExecuteActions = do
|
||||
now <- liftIO getCurrentTime
|
||||
C.mapM_ $ \case
|
||||
CourseApplicationsTableCsvSetFieldData{..} -> do
|
||||
CourseApplication{..} <- updateGet caCsvActApplication [ CourseApplicationField =. caCsvActField
|
||||
, CourseApplicationTime =. now
|
||||
]
|
||||
audit $ TransactionCourseApplicationEdit cid courseApplicationUser caCsvActApplication
|
||||
CourseApplicationsTableCsvSetVetoData{..} -> do
|
||||
CourseApplication{..} <- updateGet caCsvActApplication [ CourseApplicationRatingVeto =. caCsvActVeto
|
||||
, CourseApplicationRatingTime =. Just now
|
||||
]
|
||||
audit $ TransactionCourseApplicationEdit cid courseApplicationUser caCsvActApplication
|
||||
CourseApplicationsTableCsvSetRatingData{..} -> do
|
||||
CourseApplication{..} <- updateGet caCsvActApplication [ CourseApplicationRatingPoints =. caCsvActRating
|
||||
, CourseApplicationRatingTime =. Just now
|
||||
]
|
||||
audit $ TransactionCourseApplicationEdit cid courseApplicationUser caCsvActApplication
|
||||
CourseApplicationsTableCsvSetCommentData{..} -> do
|
||||
CourseApplication{..} <- updateGet caCsvActApplication [ CourseApplicationRatingComment =. caCsvActComment
|
||||
, CourseApplicationRatingTime =. Just now
|
||||
]
|
||||
audit $ TransactionCourseApplicationEdit cid courseApplicationUser caCsvActApplication
|
||||
return $ CourseR tid ssh csh CApplicationsR
|
||||
, dbtCsvRenderKey = \(existingApplicantName -> existingApplicantName') -> \case
|
||||
CourseApplicationsTableCsvSetFieldData{..} ->
|
||||
[whamlet|
|
||||
$newline never
|
||||
^{existingApplicantName' caCsvActApplication}
|
||||
$maybe features <- caCsvActField
|
||||
, ^{studyFeaturesWidget features}
|
||||
$nothing
|
||||
, _{MsgCourseStudyFeatureNone}
|
||||
|]
|
||||
CourseApplicationsTableCsvSetVetoData{..} ->
|
||||
[whamlet|
|
||||
$newline never
|
||||
^{existingApplicantName' caCsvActApplication}
|
||||
$if caCsvActVeto
|
||||
, _{MsgCourseApplicationVeto}
|
||||
$else
|
||||
, _{MsgCourseApplicationNoVeto}
|
||||
|]
|
||||
CourseApplicationsTableCsvSetRatingData{..} ->
|
||||
[whamlet|
|
||||
$newline never
|
||||
^{existingApplicantName' caCsvActApplication}
|
||||
$maybe newResult <- caCsvActRating
|
||||
, _{newResult}
|
||||
$nothing
|
||||
, _{MsgCourseApplicationNoRatingPoints}
|
||||
|]
|
||||
CourseApplicationsTableCsvSetCommentData{..} ->
|
||||
[whamlet|
|
||||
$newline never
|
||||
^{existingApplicantName' caCsvActApplication}
|
||||
$if is _Nothing caCsvActComment
|
||||
, _{MsgCourseApplicationNoRatingComment}
|
||||
|]
|
||||
, dbtCsvRenderActionClass = toWidget <=< ap getMessageRender . pure
|
||||
, dbtCsvRenderException = ap getMessageRender . pure :: CourseApplicationsTableCsvException -> DB Text
|
||||
}
|
||||
where
|
||||
guessUser :: CourseApplicationsTableCsv -> DB (Either UserId CourseApplicationId)
|
||||
guessUser csv = do
|
||||
mApp <- runMaybeT $ do
|
||||
appId <- squash . catchIfMaybeT (const True :: CryptoIDError -> Bool) . MaybeT . traverse decrypt $ csv ^? _csvCAApplication . _Just
|
||||
CourseApplication{..} <- MaybeT $ get appId
|
||||
guard $ courseApplicationCourse == cid
|
||||
return appId
|
||||
|
||||
maybe (Left <$> guessUser' csv) (return . Right) mApp
|
||||
where
|
||||
guessUser' :: CourseApplicationsTableCsv -> DB UserId
|
||||
guessUser' CourseApplicationsTableCsv{..} = $cachedHereBinary (csvCAMatriculation, csvCAName) $ do
|
||||
users <- E.select . E.from $ \user -> do
|
||||
E.where_ . E.and $ catMaybes
|
||||
[ (user E.^. UserMatrikelnummer E.==.) . E.val . Just <$> csvCAMatriculation
|
||||
, (user E.^. UserDisplayName E.==.) . E.val <$> csvCAName
|
||||
]
|
||||
return $ user E.^. UserId
|
||||
case users of
|
||||
[E.Value uid]
|
||||
-> return uid
|
||||
_other
|
||||
-> throwM CourseApplicationsTableCsvExceptionNoMatchingUser
|
||||
|
||||
guessAllocation :: CourseApplicationsTableCsv -> DB (Maybe AllocationId)
|
||||
guessAllocation CourseApplicationsTableCsv{..} = $cachedHereBinary csvCAAllocation . for csvCAAllocation $ \ash -> do
|
||||
mAlloc <- traverse (getJustEntity . allocationCourseAllocation . entityVal) <=< getBy $ UniqueAllocationCourse cid
|
||||
case mAlloc of
|
||||
Just (Entity allocId Allocation{..})
|
||||
| allocationShorthand == ash
|
||||
-> return allocId
|
||||
_other
|
||||
-> throwM CourseApplicationsTableCsvExceptionNoMatchingAllocation
|
||||
|
||||
existingApplicantName :: Map (E.Value CourseApplicationId) CourseApplicationsTableData -> CourseApplicationId -> Widget
|
||||
existingApplicantName existing (E.Value -> appId) = nameWidget userDisplayName userSurname
|
||||
where
|
||||
Entity _ User{..} = existing ^. singular (ix appId . resultUser)
|
||||
|
||||
lookupStudyFeatures :: CourseApplicationsTableCsv -> DB (Maybe StudyFeaturesId)
|
||||
lookupStudyFeatures csv@CourseApplicationsTableCsv{..} = do
|
||||
appRes <- guessUser csv
|
||||
(uid, oldFeatures) <- case appRes of
|
||||
Left uid -> (uid, ) <$> selectList [ CourseApplicationUser ==. uid, CourseApplicationCourse ==. cid ] []
|
||||
Right appId -> (courseApplicationUser . entityVal &&& pure) <$> getJustEntity appId
|
||||
studyFeatures <- E.select . E.from $ \(studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyTerms) ->
|
||||
E.distinctOnOrderBy [ E.asc (studyFeatures E.^. StudyFeaturesField)
|
||||
, E.asc (studyFeatures E.^. StudyFeaturesDegree)
|
||||
, E.asc (studyFeatures E.^. StudyFeaturesSemester)] $ do
|
||||
E.on $ studyTerms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField
|
||||
E.on $ studyDegree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree
|
||||
E.where_ . E.and $ catMaybes
|
||||
[ do
|
||||
field <- csvCAField
|
||||
return . E.or $ catMaybes
|
||||
[ Just $ studyTerms E.^. StudyTermsName `E.ciEq` E.just (E.val field)
|
||||
, Just $ studyTerms E.^. StudyTermsShorthand `E.ciEq` E.just (E.val field)
|
||||
, (studyTerms E.^. StudyTermsKey E.==.) . E.val <$> readMay field
|
||||
]
|
||||
, do
|
||||
degree <- csvCADegree
|
||||
return . E.or $ catMaybes
|
||||
[ Just $ studyDegree E.^. StudyDegreeName `E.ciEq` E.just (E.val degree)
|
||||
, Just $ studyDegree E.^. StudyDegreeShorthand `E.ciEq` E.just (E.val degree)
|
||||
, (studyDegree E.^. StudyDegreeKey E.==.) . E.val <$> readMay degree
|
||||
]
|
||||
, (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvCASemester
|
||||
]
|
||||
E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
|
||||
let isActiveOrPrevious = E.or
|
||||
$ (studyFeatures E.^. StudyFeaturesValid)
|
||||
: [ E.val sfid E.==. studyFeatures E.^. StudyFeaturesId
|
||||
| Entity _ CourseApplication{ courseApplicationField = Just sfid } <- oldFeatures
|
||||
]
|
||||
E.where_ isActiveOrPrevious -- either active studyFeature or the one previously associated with this course
|
||||
E.orderBy [E.desc isActiveOrPrevious, E.asc (E.orderByOrd $ studyFeatures E.^. StudyFeaturesType)]
|
||||
return $ studyFeatures E.^. StudyFeaturesId
|
||||
case studyFeatures of
|
||||
[E.Value fid] -> return $ Just fid
|
||||
_other
|
||||
| is _Nothing csvCAField
|
||||
, is _Nothing csvCADegree
|
||||
, is _Nothing csvCASemester
|
||||
-> return Nothing
|
||||
_other
|
||||
| [Entity _ CourseApplication{..}] <- oldFeatures
|
||||
, Just sfid <- courseApplicationField
|
||||
, E.Value sfid `elem` studyFeatures
|
||||
-> return $ Just sfid
|
||||
_other -> throwM CourseApplicationsTableCsvExceptionNoMatchingStudyFeatures
|
||||
|
||||
|
||||
dbtIdent = courseApplicationsIdent
|
||||
|
||||
psValidator :: PSValidator _ _
|
||||
psValidator = def
|
||||
& defaultSorting [SortAscBy "user-name"]
|
||||
|
||||
dbTableWidget' psValidator DBTable{..}
|
||||
|
||||
let title = prependCourseTitle tid ssh csh MsgCourseApplicationsListTitle
|
||||
|
||||
siteLayoutMsg title $ do
|
||||
setTitleI title
|
||||
table
|
||||
@ -5,7 +5,6 @@ module Handler.Course.Edit
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Lens
|
||||
import Utils.Form
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Invitations
|
||||
@ -106,10 +105,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse $ \html -> do
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
|
||||
uid <- liftHandlerT requireAuthId
|
||||
(lecSchools, admSchools) <- liftHandlerT . runDB $ (,)
|
||||
<$> (map (userLecturerSchool . entityVal) <$> selectList [UserLecturerUser ==. uid] [] )
|
||||
<*> (map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. uid] [] )
|
||||
let userSchools = lecSchools ++ admSchools
|
||||
userSchools <- liftHandlerT . runDB $ map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolAdmin, SchoolLecturer]] []
|
||||
|
||||
termsField <- case template of
|
||||
-- Change of term is only allowed if user may delete the course (i.e. no participants) or admin
|
||||
@ -279,11 +275,11 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse $ \html -> do
|
||||
_ -> (result, widget)
|
||||
|
||||
|
||||
validateCourse :: (MonadHandler m, HandlerSite m ~ UniWorX) => CourseForm -> m [Text]
|
||||
validateCourse :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => CourseForm -> m [Text]
|
||||
validateCourse CourseForm{..} = do
|
||||
now <- liftIO getCurrentTime
|
||||
uid <- liftHandlerT requireAuthId
|
||||
userAdmin <- liftHandlerT . runDB . getBy $ UniqueUserAdmin uid cfSchool -- FIXME: This /needs/ to be a call to `isAuthorized` on a route
|
||||
userAdmin <- hasWriteAccessTo $ SchoolR cfSchool SchoolEditR
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
allocationTerm <- for (acfAllocation <$> cfAllocation) $ fmap allocationTerm . liftHandlerT . runDB . getJust
|
||||
|
||||
@ -292,7 +288,7 @@ validateCourse CourseForm{..} = do
|
||||
prevAllocation <- fmap join . traverse get $ allocationCourseAllocation . entityVal <$> prevAllocationCourse
|
||||
|
||||
fmap join . for prevAllocation $ \Allocation{allocationStaffRegisterTo} -> if
|
||||
| is _Just userAdmin
|
||||
| userAdmin
|
||||
-> return Nothing
|
||||
| NTop allocationStaffRegisterTo <= NTop (Just now)
|
||||
-> Just . courseCapacity <$> getJust cid
|
||||
@ -310,7 +306,7 @@ validateCourse CourseForm{..} = do
|
||||
( NTop cfRegFrom <= NTop cfDeRegUntil
|
||||
, MsgCourseDeregistrationEndMustBeAfterStart
|
||||
)
|
||||
, ( maybe (anyOf (traverse . _Right . _1) (== uid) cfLecturers) (\(Entity _ UserAdmin{}) -> True) userAdmin
|
||||
, ( bool (anyOf (traverse . _Right . _1) (== uid) cfLecturers) True userAdmin
|
||||
, MsgCourseUserMustBeLecturer
|
||||
)
|
||||
, ( is _Nothing cfAllocation || is _Just cfCapacity
|
||||
@ -358,8 +354,9 @@ getCourseNewR = do
|
||||
E.&&. lecturer E.^. LecturerCourse E.==. course E.^. CourseId
|
||||
let lecturersSchool =
|
||||
E.exists $ E.from $ \user ->
|
||||
E.where_ $ user E.^. UserLecturerUser E.==. E.val uid
|
||||
E.&&. user E.^. UserLecturerSchool E.==. course E.^. CourseSchool
|
||||
E.where_ $ user E.^. UserFunctionUser E.==. E.val uid
|
||||
E.&&. user E.^. UserFunctionSchool E.==. course E.^. CourseSchool
|
||||
E.&&. user E.^. UserFunctionFunction E.==. E.val SchoolLecturer
|
||||
let courseCreated c =
|
||||
E.sub_select . E.from $ \edit -> do -- oldest edit must be creation
|
||||
E.where_ $ edit E.^. CourseEditCourse E.==. c E.^. CourseId
|
||||
@ -528,21 +525,28 @@ courseEditHandler miButtonAction mbCourseForm = do
|
||||
, formEncoding = formEnctype
|
||||
}
|
||||
|
||||
upsertAllocationCourse :: (MonadHandler m, HandlerSite m ~ UniWorX) => CourseId -> Maybe AllocationCourseForm -> ReaderT SqlBackend m ()
|
||||
upsertAllocationCourse :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => CourseId -> Maybe AllocationCourseForm -> ReaderT SqlBackend m ()
|
||||
upsertAllocationCourse cid cfAllocation = do
|
||||
now <- liftIO getCurrentTime
|
||||
uid <- liftHandlerT requireAuthId
|
||||
Course{..} <- getJust cid
|
||||
prevAllocationCourse <- getBy $ UniqueAllocationCourse cid
|
||||
prevAllocation <- fmap join . traverse get $ allocationCourseAllocation . entityVal <$> prevAllocationCourse
|
||||
userAdmin <- liftHandlerT . runDB . getBy $ UniqueUserAdmin uid courseSchool -- FIXME: This /needs/ to be a call to `isAuthorized` on a route
|
||||
userAdmin <- hasWriteAccessTo $ SchoolR courseSchool SchoolEditR
|
||||
|
||||
doEdit <- if
|
||||
| is _Just userAdmin
|
||||
| userAdmin
|
||||
-> return True
|
||||
| Just Allocation{allocationStaffRegisterTo} <- prevAllocation
|
||||
, NTop allocationStaffRegisterTo <= NTop (Just now)
|
||||
-> False <$ addMessageI Error MsgAllocationStaffRegisterToExpired
|
||||
-> let anyChanges
|
||||
| Just AllocationCourseForm{..} <- cfAllocation
|
||||
, Just (Entity _ AllocationCourse{..}) <- prevAllocationCourse
|
||||
= or [ acfAllocation /= allocationCourseAllocation
|
||||
, acfMinCapacity /= allocationCourseMinCapacity
|
||||
]
|
||||
| otherwise
|
||||
= True
|
||||
in False <$ when anyChanges (addMessageI Error MsgAllocationStaffRegisterToExpired)
|
||||
| otherwise
|
||||
-> return True
|
||||
|
||||
|
||||
@ -8,7 +8,6 @@ module Handler.Course.LecturerInvite
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Lens
|
||||
import Utils.Form
|
||||
import Handler.Utils.Invitations
|
||||
|
||||
@ -62,7 +61,7 @@ lecturerInvitationConfig = InvitationConfig{..}
|
||||
getKeyBy404 $ TermSchoolCourseShort tid csh ssh
|
||||
invitationSubject (Entity _ Course{..}) _ = return . SomeMessage $ MsgMailSubjectLecturerInvitation courseTerm courseSchool courseShorthand
|
||||
invitationHeading (Entity _ Course{..}) _ = return . SomeMessage $ MsgCourseLecInviteHeading $ CI.original courseName
|
||||
invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgCourseLecInviteExplanation}|]
|
||||
invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgCourseLecInviteExplanation}|]
|
||||
invitationTokenConfig _ _ = do
|
||||
itAuthority <- liftHandlerT requireAuthId
|
||||
return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
|
||||
|
||||
@ -10,7 +10,6 @@ import Import
|
||||
|
||||
import Data.Maybe (fromJust)
|
||||
|
||||
import Utils.Lens
|
||||
import Utils.Form
|
||||
-- import Utils.DB
|
||||
import Handler.Utils
|
||||
@ -26,39 +25,39 @@ import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
|
||||
-- NOTE: Outdated way to use dbTable; see ProfileDataR Handler for a more recent method.
|
||||
type CourseTableData = DBRow (Entity Course, Int, Bool, Entity School, [Entity User])
|
||||
type CourseTableData = DBRow (Entity Course, Int, Bool, Entity School, [Entity User], Maybe (Entity Allocation))
|
||||
|
||||
colCourse :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
|
||||
colCourse = sortable (Just "course") (i18nCell MsgCourse)
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _) } ->
|
||||
anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR)
|
||||
[whamlet|_{courseName}|]
|
||||
|
||||
colDescription :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
|
||||
colDescription = sortable Nothing mempty
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _) } ->
|
||||
case courseDescription of
|
||||
Nothing -> mempty
|
||||
(Just descr) -> cell $ modal (toWidget $ hasComment True) (Right $ toWidget descr)
|
||||
|
||||
colCShort :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
|
||||
colCShort = sortable (Just "cshort") (i18nCell MsgCourseShort)
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _) } ->
|
||||
anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|_{courseShorthand}|]
|
||||
|
||||
colTerm :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
|
||||
colTerm = sortable (Just "term") (i18nCell MsgTerm)
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _) } ->
|
||||
anchorCell (TermCourseListR courseTerm) [whamlet|#{courseTerm}|]
|
||||
|
||||
colSchoolShort :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
|
||||
colSchoolShort = sortable (Just "schoolshort") (i18nCell MsgCourseSchoolShort)
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, Entity _ School{..}, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, Entity _ School{..}, _, _) } ->
|
||||
anchorCell (TermSchoolCourseListR courseTerm courseSchool) [whamlet|_{schoolShorthand}|]
|
||||
|
||||
colRegistered :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
|
||||
colRegistered = sortable (Just "registered") (i18nCell MsgRegistered)
|
||||
$ \DBRow{ dbrOutput=(_, _, registered, _, _) } -> tickmarkCell registered
|
||||
$ \DBRow{ dbrOutput=(_, _, registered, _, _, _) } -> tickmarkCell registered
|
||||
|
||||
type CourseTableExpr = E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity School)
|
||||
|
||||
@ -91,7 +90,9 @@ makeCourseTable whereClause colChoices psValidator = do
|
||||
dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CourseTableData
|
||||
dbtProj = traverse $ \(course, E.Value participants, E.Value registered, school) -> do
|
||||
lecturerList <- lift $ E.select $ E.from $ lecturerQuery $ E.val $ entityKey course
|
||||
return (course, participants, registered, school, lecturerList)
|
||||
courseAlloc <- lift $ getBy (UniqueAllocationCourse $ entityKey course)
|
||||
>>= traverse (getJustEntity . allocationCourseAllocation . entityVal)
|
||||
return (course, participants, registered, school, lecturerList, courseAlloc)
|
||||
snd <$> dbTable psValidator DBTable
|
||||
{ dbtSQLQuery
|
||||
, dbtRowKey = \(course `E.InnerJoin` _) -> course E.^. CourseId
|
||||
@ -142,7 +143,22 @@ makeCourseTable whereClause colChoices psValidator = do
|
||||
Nothing -> E.val True
|
||||
Just b -> let regTo = course E.^. CourseRegisterTo
|
||||
regFrom = course E.^. CourseRegisterFrom
|
||||
in (E.==.) (E.val b) $ (E.isNothing regTo E.||. E.val (Just now) E.<=. regTo) E.&&. E.val (Just now) E.>=. regFrom
|
||||
courseOpen = E.maybe E.false (\f -> f E.<=. E.val now) regFrom
|
||||
E.&&. E.maybe E.true (\t -> E.val now E.<=. t) regTo
|
||||
alloc allocation = do
|
||||
E.where_ . E.exists . E.from $ \allocationCourse ->
|
||||
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
|
||||
return allocation
|
||||
allocOpen allocation = ( E.maybe E.false (\f -> f E.<=. E.val now) (allocation E.^. AllocationRegisterFrom)
|
||||
E.&&. E.maybe E.true (\t -> E.val now E.<=. t) (allocation E.^. AllocationRegisterTo)
|
||||
)
|
||||
E.||. ( courseOpen
|
||||
E.&&. E.maybe E.false (\f -> f E.<=. E.val now) (allocation E.^. AllocationRegisterByCourse)
|
||||
)
|
||||
in (E.==. E.val b) $ ( courseOpen
|
||||
E.&&. E.not_ (E.exists . void $ E.from alloc)
|
||||
)
|
||||
E.||. E.exists (E.from $ E.where_ . allocOpen <=< alloc)
|
||||
)
|
||||
, ( "registered", FilterColumn $ \tExpr criterion -> case getLast (criterion :: Last Bool) of
|
||||
Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
@ -165,8 +181,8 @@ makeCourseTable whereClause colChoices psValidator = do
|
||||
]
|
||||
, dbtStyle = def
|
||||
{ dbsFilterLayout = defaultDBSFilterLayout
|
||||
, dbsTemplate = DBSTCourse (_dbrOutput . _1) (_dbrOutput . _5) (_dbrOutput . _3) (_dbrOutput . _4)
|
||||
-- ^ course ^ lecturer list ^ isRegistered ^ school
|
||||
, dbsTemplate = DBSTCourse (_dbrOutput . _1) (_dbrOutput . _5) (_dbrOutput . _3) (_dbrOutput . _4) (_dbrOutput . _6 . _Just)
|
||||
-- ^ course ^ lecturer list ^ isRegistered ^ school ^ allocation
|
||||
}
|
||||
, dbtParams = def
|
||||
, dbtIdent = "courses" :: Text
|
||||
|
||||
@ -8,7 +8,6 @@ module Handler.Course.ParticipantInvite
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Lens
|
||||
import Utils.Form
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Invitations
|
||||
@ -75,7 +74,7 @@ participantInvitationConfig = InvitationConfig{..}
|
||||
getKeyBy404 $ TermSchoolCourseShort tid csh ssh
|
||||
invitationSubject (Entity _ Course{..}) _ = return . SomeMessage $ MsgMailSubjectParticipantInvitation courseTerm courseSchool courseShorthand
|
||||
invitationHeading (Entity _ Course{..}) _ = return . SomeMessage $ MsgCourseParticipantInviteHeading $ CI.original courseName
|
||||
invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgCourseParticipantInviteExplanation}|]
|
||||
invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgCourseParticipantInviteExplanation}|]
|
||||
invitationTokenConfig _ _ = do
|
||||
itAuthority <- liftHandlerT requireAuthId
|
||||
return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
|
||||
|
||||
@ -7,7 +7,6 @@ module Handler.Course.Register
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Lens
|
||||
import Handler.Utils
|
||||
|
||||
import Data.Function ((&))
|
||||
@ -114,26 +113,26 @@ courseRegisterForm (Entity cid Course{..}) = liftHandlerT $ do
|
||||
let appFilesInfo = (,) <$> hasFiles <*> appCID
|
||||
filesMsg = bool MsgCourseRegistrationFiles MsgCourseApplicationFiles courseApplicationsRequired
|
||||
|
||||
if
|
||||
| isn't _NoUpload courseApplicationsFiles || fromMaybe False hasFiles
|
||||
-> let filesLinkField = Field{..}
|
||||
where
|
||||
fieldParse _ _ = return $ Right Nothing
|
||||
fieldEnctype = mempty
|
||||
fieldView theId _ attrs _ _
|
||||
= [whamlet|
|
||||
$newline never
|
||||
$case appFilesInfo
|
||||
$of Just (True, appCID)
|
||||
<a ##{theId} *{attrs} href=@{CApplicationR courseTerm courseSchool courseShorthand appCID CAFilesR}>
|
||||
_{filesMsg}
|
||||
$of _
|
||||
<span ##{theId} *{attrs}>
|
||||
_{MsgCourseApplicationNoFiles}
|
||||
|]
|
||||
in void $ wforced filesLinkField (fslI filesMsg) Nothing
|
||||
| otherwise
|
||||
-> return ()
|
||||
when (isn't _NoUpload courseApplicationsFiles || fromMaybe False hasFiles) $
|
||||
let filesLinkField = Field{..}
|
||||
where
|
||||
fieldParse _ _ = return $ Right Nothing
|
||||
fieldEnctype = mempty
|
||||
fieldView theId _ attrs _ _
|
||||
= [whamlet|
|
||||
$newline never
|
||||
$case appFilesInfo
|
||||
$of Just (True, appCID)
|
||||
<a ##{theId} *{attrs} href=@{CApplicationR courseTerm courseSchool courseShorthand appCID CAFilesR}>
|
||||
_{filesMsg}
|
||||
$of _
|
||||
<span ##{theId} *{attrs}>
|
||||
_{MsgCourseApplicationNoFiles}
|
||||
|]
|
||||
in void $ wforced filesLinkField (fslI filesMsg) Nothing
|
||||
|
||||
when (fromMaybe False hasFiles && isn't _NoUpload courseApplicationsFiles) $
|
||||
wformMessage <=< messageIconI Info IconFileUpload $ bool MsgCourseRegistrationFilesNeedReupload MsgCourseApplicationFilesNeedReupload courseApplicationsRequired
|
||||
|
||||
appFilesRes <- let mkFs | courseApplicationsRequired = bool MsgCourseApplicationFile MsgCourseApplicationArchive
|
||||
| otherwise = bool MsgCourseRegistrationFile MsgCourseRegistrationArchive
|
||||
@ -177,7 +176,7 @@ postCRegisterR tid ssh csh = do
|
||||
= void <$> do
|
||||
appIds <- selectKeysList [ CourseApplicationAllocation ==. Nothing, CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid ] []
|
||||
appRes <- case appIds of
|
||||
[] -> insertUnique $ CourseApplication cid uid crfStudyFeatures crfApplicationText Nothing Nothing Nothing Nothing cTime
|
||||
[] -> insertUnique $ CourseApplication cid uid crfStudyFeatures crfApplicationText False Nothing Nothing Nothing Nothing cTime Nothing
|
||||
(prevId:ps) -> do
|
||||
forM_ ps $ \appId -> do
|
||||
deleteApplicationFiles appId
|
||||
@ -218,8 +217,14 @@ postCRegisterR tid ssh csh = do
|
||||
Just _ -> addMessageIconI Success IconEnrolTrue MsgCourseRegisterOk
|
||||
BtnCourseDeregister -> runDB $ do
|
||||
deleteApplications
|
||||
deleteBy $ UniqueParticipant uid cid
|
||||
audit $ TransactionCourseParticipantDeleted cid uid
|
||||
part <- getBy $ UniqueParticipant uid cid
|
||||
forM_ part $ \(Entity partId CourseParticipant{..}) -> do
|
||||
delete $ partId
|
||||
audit $ TransactionCourseParticipantDeleted cid uid
|
||||
|
||||
when courseParticipantAllocated $ do
|
||||
now <- liftIO getCurrentTime
|
||||
insert_ $ AllocationDeregister courseParticipantUser (Just courseParticipantCourse) now Nothing
|
||||
|
||||
examRegistrations <- E.select . E.from $ \(examRegistration `E.InnerJoin` exam) -> do
|
||||
E.on $ examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
|
||||
|
||||
@ -12,7 +12,6 @@ import qualified Database.Esqueleto.Utils as E
|
||||
import Database.Esqueleto.Utils.TH
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import Utils.Lens
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
||||
@ -79,6 +78,10 @@ getCShowR tid ssh csh = do
|
||||
mRegTo <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo course
|
||||
mDereg <- traverse (formatTime SelFormatDateTime) $ courseDeregisterUntil course
|
||||
mRegAt <- traverse (formatTime SelFormatDateTime) $ courseParticipantRegistration <$> registration
|
||||
cID <- encrypt cid :: Handler CryptoUUIDCourse
|
||||
mAllocation' <- for mAllocation $ \Allocation{..} -> (,)
|
||||
<$> pure allocationName
|
||||
<*> toTextUrl (AllocationR allocationTerm allocationSchool allocationShorthand AShowR :#: cID)
|
||||
regForm <- if
|
||||
| is _Just mbAid -> do
|
||||
(courseRegisterForm', regButton) <- courseRegisterForm (Entity cid course)
|
||||
|
||||
@ -4,7 +4,6 @@ module Handler.Course.User
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Lens
|
||||
import Utils.Form
|
||||
import Handler.Utils
|
||||
import Database.Esqueleto.Utils.TH
|
||||
|
||||
@ -9,7 +9,6 @@ module Handler.Course.Users
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Lens
|
||||
import Utils.Form
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Database
|
||||
|
||||
@ -5,8 +5,6 @@ module Handler.CryptoIDDispatch
|
||||
|
||||
import Import
|
||||
|
||||
import Data.Proxy
|
||||
|
||||
import qualified Data.Text as Text
|
||||
|
||||
import Yesod.Core.Types (HandlerContents(..), ErrorResponse(..))
|
||||
|
||||
@ -8,8 +8,6 @@ import Handler.Exam.RegistrationInvite
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Exam
|
||||
import Handler.Utils.Invitations
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import qualified Data.Set as Set
|
||||
|
||||
|
||||
@ -12,8 +12,6 @@ import Import
|
||||
import Handler.Utils.Invitations
|
||||
import Handler.Utils.Exam
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import Text.Hamlet (ihamlet)
|
||||
|
||||
import Data.Aeson hiding (Result(..))
|
||||
@ -63,7 +61,7 @@ examCorrectorInvitationConfig = InvitationConfig{..}
|
||||
Course{..} <- get404 examCourse
|
||||
return . SomeMessage $ MsgMailSubjectExamCorrectorInvitation courseTerm courseSchool courseShorthand examName
|
||||
invitationHeading (Entity _ Exam{..}) _ = return . SomeMessage $ MsgExamCorrectorInviteHeading examName
|
||||
invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgExamCorrectorInviteExplanation}|]
|
||||
invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgExamCorrectorInviteExplanation}|]
|
||||
invitationTokenConfig _ _ = do
|
||||
itAuthority <- liftHandlerT requireAuthId
|
||||
return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
|
||||
|
||||
@ -6,8 +6,6 @@ import Import
|
||||
import Handler.Exam.Form
|
||||
import Handler.Exam.CorrectorInvite
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import Handler.Utils
|
||||
|
||||
@ -8,8 +8,6 @@ module Handler.Exam.Form
|
||||
) where
|
||||
|
||||
import Import
|
||||
import Utils.Lens hiding (parts)
|
||||
|
||||
import Handler.Exam.CorrectorInvite
|
||||
|
||||
import Handler.Utils
|
||||
@ -164,8 +162,8 @@ examOccurrenceForm prev = wFormToAForm $ do
|
||||
(eofNameRes, eofNameView) <- mpreq ciField ("" & addName (nudge "name")) (eofName <$> mPrev)
|
||||
(eofRoomRes, eofRoomView) <- mpreq textField ("" & addName (nudge "room")) (eofRoom <$> mPrev)
|
||||
(eofCapacityRes, eofCapacityView) <- mpreq (natFieldI MsgExamRoomCapacityNegative) ("" & addName (nudge "capacity")) (eofCapacity <$> mPrev)
|
||||
(eofStartRes, eofStartView) <- mpreq utcTimeField ("" & addName (nudge "start")) (eofStart <$> mPrev)
|
||||
(eofEndRes, eofEndView) <- mopt utcTimeField ("" & addName (nudge "end")) (eofEnd <$> mPrev)
|
||||
(eofStartRes, eofStartView) <- mpreq utcTimeField ("" & addName (nudge "start") & addDatepickerPositionAttr DPBottom) (eofStart <$> mPrev)
|
||||
(eofEndRes, eofEndView) <- mopt utcTimeField ("" & addName (nudge "end") & addDatepickerPositionAttr DPBottom) (eofEnd <$> mPrev)
|
||||
(eofDescRes, eofDescView) <- mopt htmlFieldSmall ("" & addName (nudge "description")) (eofDescription <$> mPrev)
|
||||
|
||||
return ( ExamOccurrenceForm
|
||||
@ -230,12 +228,12 @@ examPartsForm prev = wFormToAForm $ do
|
||||
|
||||
examFormTemplate :: Entity Exam -> DB ExamForm
|
||||
examFormTemplate (Entity eId Exam{..}) = do
|
||||
parts <- selectList [ ExamPartExam ==. eId ] []
|
||||
examParts <- selectList [ ExamPartExam ==. eId ] []
|
||||
occurrences <- selectList [ ExamOccurrenceExam ==. eId ] []
|
||||
correctors <- selectList [ ExamCorrectorExam ==. eId ] []
|
||||
invitations <- map (\(email, InvDBDataExamCorrector) -> email) <$> sourceInvitationsList eId
|
||||
|
||||
parts' <- forM parts $ \(Entity pid part) -> (,) <$> encrypt pid <*> pure part
|
||||
examParts' <- forM examParts $ \(Entity pid part) -> (,) <$> encrypt pid <*> pure part
|
||||
occurrences' <- forM occurrences $ \(Entity oid occ) -> (,) <$> encrypt oid <*> pure occ
|
||||
|
||||
return ExamForm
|
||||
@ -267,7 +265,7 @@ examFormTemplate (Entity eId Exam{..}) = do
|
||||
, eofDescription = examOccurrenceDescription
|
||||
}
|
||||
, efExamParts = Set.fromList $ do
|
||||
(Just -> epfId, ExamPart{..}) <- parts'
|
||||
(Just -> epfId, ExamPart{..}) <- examParts'
|
||||
return ExamPartForm
|
||||
{ epfId
|
||||
, epfName = examPartName
|
||||
|
||||
@ -16,8 +16,6 @@ import Handler.Utils.Invitations
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import Text.Hamlet (ihamlet)
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import Data.Aeson hiding (Result(..))
|
||||
|
||||
@ -71,7 +69,7 @@ examRegistrationInvitationConfig = InvitationConfig{..}
|
||||
Course{..} <- get404 examCourse
|
||||
return . SomeMessage $ MsgMailSubjectExamRegistrationInvitation courseTerm courseSchool courseShorthand examName
|
||||
invitationHeading (Entity _ Exam{..}) _ = return . SomeMessage $ MsgExamRegistrationInviteHeading examName
|
||||
invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgExamRegistrationInviteExplanation}|]
|
||||
invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgExamRegistrationInviteExplanation}|]
|
||||
invitationTokenConfig _ (InvDBDataExamRegistration{..}, _) = do
|
||||
itAuthority <- liftHandlerT requireAuthId
|
||||
let itExpiresAt = Just $ Just invDBExamRegistrationDeadline
|
||||
|
||||
@ -5,8 +5,6 @@ module Handler.Exam.Show
|
||||
import Import
|
||||
import Handler.Exam.Register
|
||||
|
||||
import Utils.Lens hiding (parts)
|
||||
|
||||
import Data.Map ((!?))
|
||||
import qualified Data.Map as Map
|
||||
|
||||
@ -24,7 +22,7 @@ getEShowR tid ssh csh examn = do
|
||||
cTime <- liftIO getCurrentTime
|
||||
mUid <- maybeAuthId
|
||||
|
||||
(Entity _ Exam{..}, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), occurrenceNamesShown) <- runDB $ do
|
||||
(Entity _ Exam{..}, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), occurrenceNamesShown) <- runDB $ do
|
||||
exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn
|
||||
|
||||
let examVisible = NTop (Just cTime) >= NTop examVisibleFrom
|
||||
@ -35,12 +33,12 @@ getEShowR tid ssh csh examn = do
|
||||
let occurrenceAssignmentsVisible = NTop (Just cTime) >= NTop examPublishOccurrenceAssignments
|
||||
occurrenceAssignmentsShown <- or2M (return occurrenceAssignmentsVisible) . hasReadAccessTo $ CExamR tid ssh csh examn EEditR
|
||||
|
||||
parts <- selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ]
|
||||
examParts <- selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ]
|
||||
|
||||
resultsRaw <- for mUid $ \uid ->
|
||||
E.select . E.from $ \examPartResult -> do
|
||||
E.where_ $ examPartResult E.^. ExamPartResultUser E.==. E.val uid
|
||||
E.&&. examPartResult E.^. ExamPartResultExamPart `E.in_` E.valList (map entityKey parts)
|
||||
E.&&. examPartResult E.^. ExamPartResultExamPart `E.in_` E.valList (map entityKey examParts)
|
||||
return examPartResult
|
||||
let results = maybe Map.empty (\rs -> Map.fromList [ (examPartResultExamPart, res) | res@(Entity _ ExamPartResult{..}) <- rs ]) resultsRaw
|
||||
|
||||
@ -66,7 +64,7 @@ getEShowR tid ssh csh examn = do
|
||||
|
||||
occurrenceNamesShown <- hasReadAccessTo $ CExamR tid ssh csh examn EEditR
|
||||
|
||||
return (exam, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), occurrenceNamesShown)
|
||||
return (exam, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), occurrenceNamesShown)
|
||||
|
||||
let examTimes = all (\(Entity _ ExamOccurrence{..}, _) -> Just examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences
|
||||
registerWidget
|
||||
|
||||
@ -6,7 +6,6 @@ module Handler.Exam.Users
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Lens
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Exam
|
||||
import Handler.Utils.Table.Columns
|
||||
@ -16,22 +15,21 @@ import Handler.Utils.Csv
|
||||
import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
import Database.Esqueleto.Utils.TH
|
||||
|
||||
|
||||
import qualified Data.Csv as Csv
|
||||
|
||||
|
||||
import Data.Map ((!))
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
|
||||
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Lens as Text
|
||||
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import Numeric.Lens (integral)
|
||||
import Control.Arrow (Kleisli(..))
|
||||
|
||||
import Database.Persist.Sql (deleteWhereCount, updateWhereCount)
|
||||
|
||||
@ -109,7 +107,7 @@ data ExamUserTableCsv = ExamUserTableCsv
|
||||
, csvEUserExerciseNumPasses :: Maybe Int
|
||||
, csvEUserExercisePointsMax :: Maybe Points
|
||||
, csvEUserExerciseNumPassesMax :: Maybe Int
|
||||
, csvEUserExamResult :: Maybe (Either ExamResultPassed ExamResultGrade)
|
||||
, csvEUserExamResult :: Maybe ExamResultPassedGrade
|
||||
, csvEUserCourseNote :: Maybe Html
|
||||
}
|
||||
deriving (Generic)
|
||||
@ -124,23 +122,20 @@ instance ToNamedRecord ExamUserTableCsv where
|
||||
instance FromNamedRecord ExamUserTableCsv where
|
||||
parseNamedRecord csv -- Manually defined awaiting issue #427
|
||||
= ExamUserTableCsv
|
||||
<$> csv .:? "surname"
|
||||
<*> csv .:? "first-name"
|
||||
<*> csv .:? "name"
|
||||
<*> csv .:? "matriculation"
|
||||
<*> csv .:? "field"
|
||||
<*> csv .:? "degree"
|
||||
<*> csv .:? "semester"
|
||||
<*> csv .:? "occurrence"
|
||||
<*> csv .:? "exercise-points"
|
||||
<*> csv .:? "exercise-num-passes"
|
||||
<*> csv .:? "exercise-points-max"
|
||||
<*> csv .:? "exercise-num-passes-max"
|
||||
<*> csv .:? "exam-result"
|
||||
<*> csv .:? "course-note"
|
||||
where
|
||||
(.:?) :: FromField (Maybe a) => Csv.NamedRecord -> ByteString -> Csv.Parser (Maybe a)
|
||||
m .:? name = Csv.lookup m name <|> return Nothing
|
||||
<$> csv .:?? "surname"
|
||||
<*> csv .:?? "first-name"
|
||||
<*> csv .:?? "name"
|
||||
<*> csv .:?? "matriculation"
|
||||
<*> csv .:?? "field"
|
||||
<*> csv .:?? "degree"
|
||||
<*> csv .:?? "semester"
|
||||
<*> csv .:?? "occurrence"
|
||||
<*> csv .:?? "exercise-points"
|
||||
<*> csv .:?? "exercise-num-passes"
|
||||
<*> csv .:?? "exercise-points-max"
|
||||
<*> csv .:?? "exercise-num-passes-max"
|
||||
<*> csv .:?? "exam-result"
|
||||
<*> csv .:?? "course-note"
|
||||
|
||||
instance DefaultOrdered ExamUserTableCsv where
|
||||
headerOrder = Csv.genericHeaderOrder examUserTableCsvOptions
|
||||
@ -209,7 +204,7 @@ data ExamUserCsvAction
|
||||
}
|
||||
| ExamUserCsvSetResultData
|
||||
{ examUserCsvActUser :: UserId
|
||||
, examUserCsvActExamResult :: Maybe (Either ExamResultPassed ExamResultGrade)
|
||||
, examUserCsvActExamResult :: Maybe ExamResultPassedGrade
|
||||
}
|
||||
| ExamUserCsvSetCourseNoteData
|
||||
{ examUserCsvActUser :: UserId
|
||||
@ -244,8 +239,8 @@ postEUsersR tid ssh csh examn = do
|
||||
showPasses = numSheetsPasses allBoni /= 0
|
||||
showPoints = getSum (numSheetsPoints allBoni) /= 0
|
||||
|
||||
resultView :: ExamResultGrade -> Either ExamResultPassed ExamResultGrade
|
||||
resultView = bool (Left . over _examResult (view passingGrade)) Right examShowGrades
|
||||
resultView :: ExamResultGrade -> ExamResultPassedGrade
|
||||
resultView = fmap $ bool (Left . view passingGrade) Right examShowGrades
|
||||
|
||||
let
|
||||
examUsersDBTable = DBTable{..}
|
||||
@ -320,7 +315,7 @@ postEUsersR tid ssh csh examn = do
|
||||
criteria''
|
||||
| ExamAttended (ExamPassed True) `Set.member` criteria
|
||||
= criteria' `Set.union` Set.fromList passed
|
||||
| otherwise
|
||||
| otherwise
|
||||
= criteria'
|
||||
in queryExamResult row E.?. ExamResultResult `E.in_` E.valList (Just <$> Set.toList criteria'')
|
||||
)
|
||||
@ -431,7 +426,7 @@ postEUsersR tid ssh csh examn = do
|
||||
ExamUserCsvCourseRegister -> DBCsvActionNew
|
||||
ExamUserCsvRegister -> DBCsvActionNew
|
||||
ExamUserCsvDeregister -> DBCsvActionMissing
|
||||
_other -> DBCsvActionExisting
|
||||
_other -> DBCsvActionExisting
|
||||
, dbtCsvExecuteActions = do
|
||||
C.mapM_ $ \case
|
||||
ExamUserCsvCourseRegisterData{..} -> do
|
||||
@ -471,7 +466,7 @@ postEUsersR tid ssh csh examn = do
|
||||
deleteBy $ UniqueExamResult eid examUserCsvActUser
|
||||
audit $ TransactionExamResultDeleted eid examUserCsvActUser
|
||||
Just res -> do
|
||||
let res' = either (over _examResult $ review passingGrade) id res
|
||||
let res' = either (review passingGrade) id <$> res
|
||||
now <- liftIO getCurrentTime
|
||||
void $ upsertBy
|
||||
(UniqueExamResult eid examUserCsvActUser)
|
||||
@ -496,7 +491,7 @@ postEUsersR tid ssh csh examn = do
|
||||
ExamUserCsvSetCourseNoteData{ examUserCsvActCourseNote = Just note, .. } -> do
|
||||
now <- liftIO getCurrentTime
|
||||
uid <- liftHandlerT requireAuthId
|
||||
Entity nid _ <- upsert (CourseUserNote examCourse examUserCsvActUser note) [ CourseUserNoteNote =. note ]
|
||||
Entity nid _ <- upsert (CourseUserNote examCourse examUserCsvActUser note) [ CourseUserNoteNote =. note ]
|
||||
insert_ $ CourseUserNoteEdit uid now nid
|
||||
return $ CExamR tid ssh csh examn EUsersR
|
||||
, dbtCsvRenderKey = \(registeredUserName -> registeredUserName') -> \case
|
||||
@ -550,11 +545,7 @@ postEUsersR tid ssh csh examn = do
|
||||
$newline never
|
||||
^{nameWidget userDisplayName userSurname}
|
||||
$maybe newResult <- examUserCsvActExamResult
|
||||
$case newResult
|
||||
$of Left pResult
|
||||
, _{pResult}
|
||||
$of Right gResult
|
||||
, _{gResult}
|
||||
, _{newResult}
|
||||
$nothing
|
||||
, _{MsgExamResultNone}
|
||||
|]
|
||||
@ -572,19 +563,11 @@ postEUsersR tid ssh csh examn = do
|
||||
, dbtCsvRenderException = ap getMessageRender . pure :: ExamUserCsvException -> DB Text
|
||||
}
|
||||
where
|
||||
studyFeaturesWidget :: StudyFeaturesId -> Widget
|
||||
studyFeaturesWidget featId = do
|
||||
(StudyFeatures{studyFeaturesSemester}, (degree, terms)) <- liftHandlerT . runDB . ($ featId) . runKleisli $ Kleisli getJust >>> Kleisli return &&& Kleisli (getJust . studyFeaturesDegree) &&& Kleisli (getJust . studyFeaturesField)
|
||||
[whamlet|
|
||||
$newline never
|
||||
_{StudyDegreeTerm degree terms}, _{MsgStudyFeatureAge} #{studyFeaturesSemester}
|
||||
|]
|
||||
|
||||
registeredUserName :: Map (E.Value ExamRegistrationId) ExamUserTableData -> ExamRegistrationId -> Widget
|
||||
registeredUserName existing (E.Value -> registration) = nameWidget userDisplayName userSurname
|
||||
where
|
||||
Entity _ User{..} = view resultUser $ existing ! registration
|
||||
|
||||
|
||||
guessUser :: ExamUserTableCsv -> DB (Bool, UserId)
|
||||
guessUser ExamUserTableCsv{..} = $cachedHereBinary (csvEUserMatriculation, csvEUserName, csvEUserSurname) $ do
|
||||
users <- E.select . E.from $ \user -> do
|
||||
@ -617,30 +600,39 @@ postEUsersR tid ssh csh examn = do
|
||||
lookupStudyFeatures :: ExamUserTableCsv -> DB (Maybe StudyFeaturesId)
|
||||
lookupStudyFeatures csv@ExamUserTableCsv{..} = do
|
||||
uid <- view _2 <$> guessUser csv
|
||||
studyFeatures <- E.select . E.from $ \(studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyTerms) -> do
|
||||
E.on $ studyTerms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField
|
||||
E.on $ studyDegree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree
|
||||
E.where_ . E.and $ catMaybes
|
||||
[ do
|
||||
field <- csvEUserField
|
||||
return . E.or $ catMaybes
|
||||
[ Just $ studyTerms E.^. StudyTermsName `E.ciEq` E.just (E.val field)
|
||||
, Just $ studyTerms E.^. StudyTermsShorthand `E.ciEq` E.just (E.val field)
|
||||
, (studyTerms E.^. StudyTermsKey E.==.) . E.val <$> readMay field
|
||||
]
|
||||
, do
|
||||
degree <- csvEUserDegree
|
||||
return . E.or $ catMaybes
|
||||
[ Just $ studyDegree E.^. StudyDegreeName `E.ciEq` E.just (E.val degree)
|
||||
, Just $ studyDegree E.^. StudyDegreeShorthand `E.ciEq` E.just (E.val degree)
|
||||
, (studyDegree E.^. StudyDegreeKey E.==.) . E.val <$> readMay degree
|
||||
]
|
||||
, (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvEUserSemester
|
||||
]
|
||||
E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
|
||||
E.&&. studyFeatures E.^. StudyFeaturesValid E.==. E.val True
|
||||
E.limit 2
|
||||
return $ studyFeatures E.^. StudyFeaturesId
|
||||
oldFeatures <- getBy $ UniqueParticipant uid examCourse
|
||||
studyFeatures <- E.select . E.from $ \(studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyTerms) ->
|
||||
E.distinctOnOrderBy [ E.asc (studyFeatures E.^. StudyFeaturesField)
|
||||
, E.asc (studyFeatures E.^. StudyFeaturesDegree)
|
||||
, E.asc (studyFeatures E.^. StudyFeaturesSemester)] $ do
|
||||
E.on $ studyTerms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField
|
||||
E.on $ studyDegree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree
|
||||
E.where_ . E.and $ catMaybes
|
||||
[ do
|
||||
field <- csvEUserField
|
||||
return . E.or $ catMaybes
|
||||
[ Just $ studyTerms E.^. StudyTermsName `E.ciEq` E.just (E.val field)
|
||||
, Just $ studyTerms E.^. StudyTermsShorthand `E.ciEq` E.just (E.val field)
|
||||
, (studyTerms E.^. StudyTermsKey E.==.) . E.val <$> readMay field
|
||||
]
|
||||
, do
|
||||
degree <- csvEUserDegree
|
||||
return . E.or $ catMaybes
|
||||
[ Just $ studyDegree E.^. StudyDegreeName `E.ciEq` E.just (E.val degree)
|
||||
, Just $ studyDegree E.^. StudyDegreeShorthand `E.ciEq` E.just (E.val degree)
|
||||
, (studyDegree E.^. StudyDegreeKey E.==.) . E.val <$> readMay degree
|
||||
]
|
||||
, (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvEUserSemester
|
||||
]
|
||||
E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
|
||||
let isActive = studyFeatures E.^. StudyFeaturesValid E.==. E.val True
|
||||
isActiveOrPrevious = case oldFeatures of
|
||||
Just (Entity _ CourseParticipant{courseParticipantField = Just sfid})
|
||||
-> isActive E.||. (E.val sfid E.==. studyFeatures E.^. StudyFeaturesId)
|
||||
_ -> isActive
|
||||
E.where_ isActiveOrPrevious -- either active studyFeature or the one previously associated with this course
|
||||
E.orderBy [E.desc isActiveOrPrevious, E.asc (E.orderByOrd $ studyFeatures E.^. StudyFeaturesType)]
|
||||
return $ studyFeatures E.^. StudyFeaturesId
|
||||
case studyFeatures of
|
||||
[E.Value fid] -> return $ Just fid
|
||||
_other
|
||||
@ -648,6 +640,11 @@ postEUsersR tid ssh csh examn = do
|
||||
, is _Nothing csvEUserDegree
|
||||
, is _Nothing csvEUserSemester
|
||||
-> return Nothing
|
||||
_other
|
||||
| Just (Entity _ CourseParticipant{..}) <- oldFeatures
|
||||
, Just sfid <- courseParticipantField
|
||||
, E.Value sfid `elem` studyFeatures
|
||||
-> return $ Just sfid
|
||||
_other -> throwM ExamUserCsvExceptionNoMatchingStudyFeatures
|
||||
|
||||
examUsersDBTableValidator = def & defaultSorting [SortAscBy "user-name"]
|
||||
|
||||
@ -5,8 +5,6 @@ import Import
|
||||
import qualified Data.Aeson.Encode.Pretty as Aeson
|
||||
import qualified Data.Text.Lazy.Builder as Builder
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import qualified Data.UUID as UUID
|
||||
|
||||
import Data.Semigroup (Min(..), Max(..))
|
||||
|
||||
@ -2,7 +2,6 @@ module Handler.Home where
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Lens
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Table.Cells
|
||||
|
||||
@ -15,78 +14,16 @@ import qualified Database.Esqueleto.Utils as E
|
||||
getHomeR :: Handler Html
|
||||
getHomeR = do
|
||||
muid <- maybeAuthId
|
||||
upcomingExamsWidget <- for muid $ runDB . homeUpcomingExams
|
||||
defaultLayout $ do
|
||||
setTitleI MsgHomeHeading
|
||||
fromMaybe mempty upcomingExamsWidget
|
||||
maybe mempty homeUpcomingSheets muid
|
||||
homeOpenCourses
|
||||
case muid of
|
||||
Just uid -> do
|
||||
homeUpcomingExams uid
|
||||
homeUpcomingSheets uid
|
||||
Nothing ->
|
||||
$(i18nWidgetFile "unauth-home")
|
||||
|
||||
|
||||
homeOpenCourses :: Widget
|
||||
homeOpenCourses = do
|
||||
cTime <- liftIO getCurrentTime
|
||||
let tableData :: E.SqlExpr (Entity Course)
|
||||
-> E.SqlQuery (E.SqlExpr (Entity Course))
|
||||
tableData course = do
|
||||
E.where_ $ E.not_ (E.isNothing $ course E.^. CourseRegisterFrom) -- DO: do this with isAuthorized in dbtProj
|
||||
E.&&. (course E.^. CourseRegisterFrom E.<=. E.val (Just cTime))
|
||||
E.&&. ( E.isNothing (course E.^. CourseRegisterTo)
|
||||
E.||. course E.^. CourseRegisterTo E.>=. E.val (Just cTime)
|
||||
)
|
||||
return course
|
||||
|
||||
colonnade :: Colonnade Sortable (DBRow (Entity Course)) (DBCell (HandlerT UniWorX IO) ())
|
||||
colonnade = mconcat
|
||||
[ -- dbRow
|
||||
sortable (Just "term") (i18nCell MsgTerm)
|
||||
$ \DBRow{ dbrOutput=Entity{entityVal = Course{..}} } ->
|
||||
anchorCell (TermCourseListR courseTerm) [whamlet|#{courseTerm}|]
|
||||
, sortable (Just "schoolshort") (i18nCell MsgCourseSchoolShort)
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}) } ->
|
||||
anchorCell (TermSchoolCourseListR courseTerm courseSchool) [whamlet|_{unSchoolKey courseSchool}|]
|
||||
, sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=Entity{entityVal = course} } -> do
|
||||
let tid = courseTerm course
|
||||
ssh = courseSchool course
|
||||
csh = courseShorthand course
|
||||
anchorCell (CourseR tid ssh csh CShowR) csh
|
||||
, sortable (Just "deadline") (i18nCell MsgRegisterTo) $ \DBRow{ dbrOutput=Entity{entityVal = course} } ->
|
||||
cell $ traverse (formatTime SelFormatDateTime) (courseRegisterTo course) >>= maybe mempty toWidget
|
||||
]
|
||||
courseTable <- liftHandlerT . runDB $ dbTableWidget' def DBTable
|
||||
{ dbtSQLQuery = tableData
|
||||
, dbtRowKey = (E.^. CourseId)
|
||||
, dbtColonnade = colonnade
|
||||
, dbtProj = return
|
||||
, dbtSorting = Map.fromList
|
||||
[ ( "term"
|
||||
, SortColumn $ \course -> course E.^. CourseTerm
|
||||
)
|
||||
, ( "schoolshort"
|
||||
, SortColumn $ \course -> course E.^. CourseSchool
|
||||
)
|
||||
, ( "course"
|
||||
, SortColumn $ \course -> course E.^. CourseShorthand
|
||||
)
|
||||
, ( "deadline"
|
||||
, SortColumn $ \course -> course E.^. CourseRegisterTo
|
||||
)
|
||||
]
|
||||
, dbtFilter = mempty {- [ ( "term"
|
||||
, FilterColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) tids -> if
|
||||
| Set.null tids -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
| otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids)
|
||||
)
|
||||
] -}
|
||||
, dbtFilterUI = mempty
|
||||
, dbtStyle = def
|
||||
, dbtParams = def
|
||||
, dbtIdent = "open-courses" :: Text
|
||||
, dbtCsvEncode = noCsvEncode
|
||||
, dbtCsvDecode = Nothing
|
||||
}
|
||||
$(widgetFile "home/openCourses")
|
||||
|
||||
homeUpcomingSheets :: UserId -> Widget
|
||||
homeUpcomingSheets uid = do
|
||||
cTime <- liftIO getCurrentTime
|
||||
@ -189,134 +126,137 @@ homeUpcomingSheets uid = do
|
||||
$(widgetFile "home/upcomingSheets")
|
||||
|
||||
|
||||
|
||||
homeUpcomingExams :: UserId -> DB Widget
|
||||
homeUpcomingExams :: UserId -> Widget
|
||||
homeUpcomingExams uid = do
|
||||
now <- liftIO getCurrentTime
|
||||
let fortnight = addWeeks 2 now
|
||||
let -- code copied and slightly adapted from Handler.Course.getCShowR:
|
||||
examDBTable = DBTable{..}
|
||||
where
|
||||
-- for ease of refactoring:
|
||||
queryCourse = $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
|
||||
queryExam = $(sqlIJproj 2 2) . $(sqlLOJproj 3 1)
|
||||
lensCourse = _1
|
||||
lensExam = _2
|
||||
lensRegister = _3 . _Just
|
||||
lensOccurrence = _4 . _Just
|
||||
((Any hasExams, examTable), warningDays) <- liftHandlerT . runDB $ do
|
||||
User {userWarningDays} <- get404 uid
|
||||
let fortnight = addUTCTime userWarningDays now
|
||||
let -- code copied and slightly adapted from Handler.Course.getCShowR:
|
||||
examDBTable = DBTable{..}
|
||||
where
|
||||
-- for ease of refactoring:
|
||||
queryCourse = $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
|
||||
queryExam = $(sqlIJproj 2 2) . $(sqlLOJproj 3 1)
|
||||
lensCourse = _1
|
||||
lensExam = _2
|
||||
lensRegister = _3 . _Just
|
||||
lensOccurrence = _4 . _Just
|
||||
|
||||
dbtSQLQuery ((course `E.InnerJoin` exam) `E.LeftOuterJoin` register `E.LeftOuterJoin` occurrence) = do
|
||||
E.on $ register E.?. ExamRegistrationOccurrence E.==. E.just (occurrence E.?. ExamOccurrenceId)
|
||||
E.on $ register E.?. ExamRegistrationExam E.==. E.just (exam E.^. ExamId)
|
||||
E.&&. register E.?. ExamRegistrationUser E.==. E.just (E.val uid)
|
||||
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
|
||||
E.where_ $ E.exists $ E.from $ \participant ->
|
||||
E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
|
||||
E.&&. participant E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||
let regToWithinFortnight = exam E.^. ExamRegisterTo E.<=. E.just (E.val fortnight)
|
||||
E.&&. exam E.^. ExamRegisterTo E.>=. E.just (E.val now)
|
||||
E.&&. E.isNothing (register E.?. ExamRegistrationId)
|
||||
startExamFortnight = exam E.^. ExamStart E.<=. E.just (E.val fortnight)
|
||||
E.&&. exam E.^. ExamStart E.>=. E.just (E.val now)
|
||||
E.&&. E.isJust (register E.?. ExamRegistrationId)
|
||||
startOccurFortnight = occurrence E.?. ExamOccurrenceStart E.<=. E.just (E.val fortnight)
|
||||
E.&&. occurrence E.?. ExamOccurrenceStart E.>=. E.just (E.val now)
|
||||
E.&&. E.isJust (register E.?. ExamRegistrationId)
|
||||
earliestOccurrence = E.sub_select $ E.from $ \occ -> do
|
||||
E.where_ $ occ E.^. ExamOccurrenceExam E.==. exam E.^. ExamId
|
||||
E.&&. occ E.^. ExamOccurrenceStart E.>=. E.val now
|
||||
return $ E.min_ $ occ E.^. ExamOccurrenceStart
|
||||
startEarliest = E.isNothing (occurrence E.?. ExamOccurrenceId)
|
||||
E.&&. earliestOccurrence E.<=. E.just (E.val fortnight)
|
||||
-- E.&&. earliestOccurrence E.>=. E.just (E.val now)
|
||||
E.where_ $ regToWithinFortnight E.||. startExamFortnight E.||. startOccurFortnight E.||. startEarliest
|
||||
return (course, exam, register, occurrence)
|
||||
dbtRowKey = queryExam >>> (E.^. ExamId)
|
||||
dbtProj r@DBRow{ dbrOutput } = do
|
||||
let Entity _ Exam{..} = view lensExam dbrOutput
|
||||
Entity _ Course{..} = view lensCourse dbrOutput
|
||||
guardM . hasReadAccessTo $ CExamR courseTerm courseSchool courseShorthand examName EShowR -- check access rights
|
||||
return r
|
||||
dbtColonnade = dbColonnade $ mconcat
|
||||
[ sortable (Just "term") (i18nCell MsgTerm) $ \DBRow{ dbrOutput = view lensCourse -> Entity _ Course{..} } ->
|
||||
msgCell courseTerm
|
||||
, sortable (Just "school") (i18nCell MsgCourseSchool) $ \DBRow{ dbrOutput = view lensCourse -> Entity _ Course{..} } ->
|
||||
msgCell courseSchool
|
||||
, sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput = view lensCourse -> Entity _ Course{..} } ->
|
||||
anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) (toWgt courseShorthand)
|
||||
-- continue here
|
||||
, sortable (Just "name") (i18nCell MsgExamName) $ \DBRow{ dbrOutput } -> do
|
||||
let Entity _ Exam{..} = view lensExam dbrOutput
|
||||
Entity _ Course{..} = view lensCourse dbrOutput
|
||||
indicatorCell <> anchorCell (CExamR courseTerm courseSchool courseShorthand examName EShowR) examName
|
||||
, sortable (Just "register-from") (i18nCell MsgExamRegisterFrom) $ \DBRow { dbrOutput = view lensExam -> Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterFrom
|
||||
, sortable (Just "register-to") (i18nCell MsgExamRegisterTo) $ \DBRow { dbrOutput = view lensExam -> Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterTo
|
||||
, sortable (Just "time") (i18nCell MsgExamTime) $ \DBRow{ dbrOutput } ->
|
||||
if | Just (Entity _ ExamOccurrence{..}) <- preview lensOccurrence dbrOutput
|
||||
-> cell $ formatTimeRangeW SelFormatDateTime examOccurrenceStart examOccurrenceEnd
|
||||
| Entity _ Exam{..} <- view lensExam dbrOutput
|
||||
, Just start <- examStart -> cell $ formatTimeRangeW SelFormatDateTime start examEnd
|
||||
| otherwise -> mempty
|
||||
{- NOTE: We do not want thoughtless exam registrations, since many people click "register" and don't show up, causing logistic problems.
|
||||
Hence we force them here to click twice. Maybe add a captcha where users have to distinguish pictures showing pink elephants and course lecturers.
|
||||
, sortable Nothing mempty $ \DBRow{ dbrOutput } -> sqlCell $ do
|
||||
let Entity eId Exam{..} = view lensExam dbrOutput
|
||||
Entity _ Course{..} = view lensCourse dbrOutput
|
||||
mayRegister <- (== Authorized) <$> evalAccessDB (CExamR courseTerm courseSchool courseShorthand examName ERegisterR) True
|
||||
isRegistered <- existsBy $ UniqueExamRegistration eId uid
|
||||
if
|
||||
| mayRegister -> do
|
||||
(examRegisterForm, examRegisterEnctype) <- liftHandlerT . generateFormPost . buttonForm' $ bool [BtnRegister] [BtnDeregister] isRegistered
|
||||
return $ wrapForm examRegisterForm def
|
||||
{ formAction = Just . SomeRoute $ CExamR courseTerm courseSchool courseShorthand examName ERegisterR
|
||||
, formEncoding = examRegisterEnctype
|
||||
, formSubmit = FormNoSubmit
|
||||
}
|
||||
| isRegistered -> return [whamlet|_{MsgExamRegistered}|]
|
||||
| otherwise -> return mempty
|
||||
-}
|
||||
, sortable (Just "registered") (i18nCell MsgExamRegistration ) $ \DBRow{ dbrOutput } -> sqlCell $ do
|
||||
let Entity _ Exam{..} = view lensExam dbrOutput
|
||||
Entity _ Course{..} = view lensCourse dbrOutput
|
||||
mayRegister <- (== Authorized) <$> evalAccessDB (CExamR courseTerm courseSchool courseShorthand examName ERegisterR) True
|
||||
let isRegistered = has lensRegister dbrOutput
|
||||
label = bool MsgExamNotRegistered MsgExamRegistered isRegistered
|
||||
examUrl = CExamR courseTerm courseSchool courseShorthand examName EShowR
|
||||
if | mayRegister -> return $ simpleLinkI (SomeMessage label) examUrl
|
||||
| otherwise -> return [whamlet|_{label}|]
|
||||
, sortable (toNothingS "occurrence") (i18nCell MsgExamOccurrence) $ \DBRow{ dbrOutput } ->
|
||||
if | Just (Entity _ ExamOccurrence{..}) <- preview lensOccurrence dbrOutput
|
||||
-> textCell examOccurrenceRoom
|
||||
| otherwise -> mempty
|
||||
]
|
||||
dbtSorting = Map.fromList
|
||||
[ ("demo-both", SortColumn $ queryCourse &&& queryExam >>> (\(_course,exam)-> exam E.^. ExamName))
|
||||
, ("term", SortColumn $ queryCourse >>> (E.^. CourseTerm ))
|
||||
, ("school", SortColumn $ queryCourse >>> (E.^. CourseSchool ))
|
||||
, ("course", SortColumn $ queryCourse >>> (E.^. CourseShorthand ))
|
||||
, ("name", SortColumn $ queryExam >>> (E.^. ExamName ))
|
||||
, ("time", SortColumn $ queryExam >>> (E.^. ExamStart ))
|
||||
, ("register-from", SortColumn $ queryExam >>> (E.^. ExamRegisterFrom ))
|
||||
, ("register-to", SortColumn $ queryExam >>> (E.^. ExamRegisterTo ))
|
||||
, ("visible", SortColumn $ queryExam >>> (E.^. ExamVisibleFrom ))
|
||||
, ("registered", SortColumn $ queryExam >>> (\exam ->
|
||||
E.exists $ E.from $ \registration -> do
|
||||
E.where_ $ registration E.^. ExamRegistrationUser E.==. E.val uid
|
||||
E.where_ $ registration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
|
||||
))
|
||||
]
|
||||
dbtFilter = Map.empty
|
||||
dbtFilterUI = const mempty
|
||||
dbtStyle = def
|
||||
dbtParams = def
|
||||
dbtIdent :: Text
|
||||
dbtIdent = "exams"
|
||||
dbtCsvEncode = noCsvEncode
|
||||
dbtCsvDecode = Nothing
|
||||
dbtSQLQuery ((course `E.InnerJoin` exam) `E.LeftOuterJoin` register `E.LeftOuterJoin` occurrence) = do
|
||||
E.on $ register E.?. ExamRegistrationOccurrence E.==. E.just (occurrence E.?. ExamOccurrenceId)
|
||||
E.on $ register E.?. ExamRegistrationExam E.==. E.just (exam E.^. ExamId)
|
||||
E.&&. register E.?. ExamRegistrationUser E.==. E.just (E.val uid)
|
||||
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
|
||||
E.where_ $ E.exists $ E.from $ \participant ->
|
||||
E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
|
||||
E.&&. participant E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||
let regToWithinFortnight = exam E.^. ExamRegisterTo E.<=. E.just (E.val fortnight)
|
||||
E.&&. exam E.^. ExamRegisterTo E.>=. E.just (E.val now)
|
||||
E.&&. E.isNothing (register E.?. ExamRegistrationId)
|
||||
startExamFortnight = exam E.^. ExamStart E.<=. E.just (E.val fortnight)
|
||||
E.&&. exam E.^. ExamStart E.>=. E.just (E.val now)
|
||||
E.&&. E.isJust (register E.?. ExamRegistrationId)
|
||||
startOccurFortnight = occurrence E.?. ExamOccurrenceStart E.<=. E.just (E.val fortnight)
|
||||
E.&&. occurrence E.?. ExamOccurrenceStart E.>=. E.just (E.val now)
|
||||
E.&&. E.isJust (register E.?. ExamRegistrationId)
|
||||
earliestOccurrence = E.sub_select $ E.from $ \occ -> do
|
||||
E.where_ $ occ E.^. ExamOccurrenceExam E.==. exam E.^. ExamId
|
||||
E.&&. occ E.^. ExamOccurrenceStart E.>=. E.val now
|
||||
return $ E.min_ $ occ E.^. ExamOccurrenceStart
|
||||
startEarliest = E.isNothing (occurrence E.?. ExamOccurrenceId)
|
||||
E.&&. earliestOccurrence E.<=. E.just (E.val fortnight)
|
||||
-- E.&&. earliestOccurrence E.>=. E.just (E.val now)
|
||||
E.where_ $ regToWithinFortnight E.||. startExamFortnight E.||. startOccurFortnight E.||. startEarliest
|
||||
return (course, exam, register, occurrence)
|
||||
dbtRowKey = queryExam >>> (E.^. ExamId)
|
||||
dbtProj r@DBRow{ dbrOutput } = do
|
||||
let Entity _ Exam{..} = view lensExam dbrOutput
|
||||
Entity _ Course{..} = view lensCourse dbrOutput
|
||||
guardM . hasReadAccessTo $ CExamR courseTerm courseSchool courseShorthand examName EShowR -- check access rights
|
||||
return r
|
||||
dbtColonnade = dbColonnade $ mconcat
|
||||
[ sortable (Just "term") (i18nCell MsgTerm) $ \DBRow{ dbrOutput = view lensCourse -> Entity _ Course{..} } ->
|
||||
msgCell courseTerm
|
||||
, sortable (Just "school") (i18nCell MsgCourseSchool) $ \DBRow{ dbrOutput = view lensCourse -> Entity _ Course{..} } ->
|
||||
msgCell courseSchool
|
||||
, sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput = view lensCourse -> Entity _ Course{..} } ->
|
||||
anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) (toWgt courseShorthand)
|
||||
-- continue here
|
||||
, sortable (Just "name") (i18nCell MsgExamName) $ \DBRow{ dbrOutput } -> do
|
||||
let Entity _ Exam{..} = view lensExam dbrOutput
|
||||
Entity _ Course{..} = view lensCourse dbrOutput
|
||||
indicatorCell <> anchorCell (CExamR courseTerm courseSchool courseShorthand examName EShowR) examName
|
||||
, sortable (Just "register-from") (i18nCell MsgExamRegisterFrom) $ \DBRow { dbrOutput = view lensExam -> Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterFrom
|
||||
, sortable (Just "register-to") (i18nCell MsgExamRegisterTo) $ \DBRow { dbrOutput = view lensExam -> Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterTo
|
||||
, sortable (Just "time") (i18nCell MsgExamTime) $ \DBRow{ dbrOutput } ->
|
||||
if | Just (Entity _ ExamOccurrence{..}) <- preview lensOccurrence dbrOutput
|
||||
-> cell $ formatTimeRangeW SelFormatDateTime examOccurrenceStart examOccurrenceEnd
|
||||
| Entity _ Exam{..} <- view lensExam dbrOutput
|
||||
, Just start <- examStart -> cell $ formatTimeRangeW SelFormatDateTime start examEnd
|
||||
| otherwise -> mempty
|
||||
{- NOTE: We do not want thoughtless exam registrations, since many people click "register" and don't show up, causing logistic problems.
|
||||
Hence we force them here to click twice. Maybe add a captcha where users have to distinguish pictures showing pink elephants and course lecturers.
|
||||
, sortable Nothing mempty $ \DBRow{ dbrOutput } -> sqlCell $ do
|
||||
let Entity eId Exam{..} = view lensExam dbrOutput
|
||||
Entity _ Course{..} = view lensCourse dbrOutput
|
||||
mayRegister <- (== Authorized) <$> evalAccessDB (CExamR courseTerm courseSchool courseShorthand examName ERegisterR) True
|
||||
isRegistered <- existsBy $ UniqueExamRegistration eId uid
|
||||
if
|
||||
| mayRegister -> do
|
||||
(examRegisterForm, examRegisterEnctype) <- liftHandlerT . generateFormPost . buttonForm' $ bool [BtnRegister] [BtnDeregister] isRegistered
|
||||
return $ wrapForm examRegisterForm def
|
||||
{ formAction = Just . SomeRoute $ CExamR courseTerm courseSchool courseShorthand examName ERegisterR
|
||||
, formEncoding = examRegisterEnctype
|
||||
, formSubmit = FormNoSubmit
|
||||
}
|
||||
| isRegistered -> return [whamlet|_{MsgExamRegistered}|]
|
||||
| otherwise -> return mempty
|
||||
-}
|
||||
, sortable (Just "registered") (i18nCell MsgExamRegistration ) $ \DBRow{ dbrOutput } -> sqlCell $ do
|
||||
let Entity _ Exam{..} = view lensExam dbrOutput
|
||||
Entity _ Course{..} = view lensCourse dbrOutput
|
||||
mayRegister <- (== Authorized) <$> evalAccessDB (CExamR courseTerm courseSchool courseShorthand examName ERegisterR) True
|
||||
let isRegistered = has lensRegister dbrOutput
|
||||
label = bool MsgExamNotRegistered MsgExamRegistered isRegistered
|
||||
examUrl = CExamR courseTerm courseSchool courseShorthand examName EShowR
|
||||
if | mayRegister -> return $ simpleLinkI (SomeMessage label) examUrl
|
||||
| otherwise -> return [whamlet|_{label}|]
|
||||
, sortable (toNothingS "occurrence") (i18nCell MsgExamOccurrence) $ \DBRow{ dbrOutput } ->
|
||||
if | Just (Entity _ ExamOccurrence{..}) <- preview lensOccurrence dbrOutput
|
||||
-> textCell examOccurrenceRoom
|
||||
| otherwise -> mempty
|
||||
]
|
||||
dbtSorting = Map.fromList
|
||||
[ ("demo-both", SortColumn $ queryCourse &&& queryExam >>> (\(_course,exam)-> exam E.^. ExamName))
|
||||
, ("term", SortColumn $ queryCourse >>> (E.^. CourseTerm ))
|
||||
, ("school", SortColumn $ queryCourse >>> (E.^. CourseSchool ))
|
||||
, ("course", SortColumn $ queryCourse >>> (E.^. CourseShorthand ))
|
||||
, ("name", SortColumn $ queryExam >>> (E.^. ExamName ))
|
||||
, ("time", SortColumn $ queryExam >>> (E.^. ExamStart ))
|
||||
, ("register-from", SortColumn $ queryExam >>> (E.^. ExamRegisterFrom ))
|
||||
, ("register-to", SortColumn $ queryExam >>> (E.^. ExamRegisterTo ))
|
||||
, ("visible", SortColumn $ queryExam >>> (E.^. ExamVisibleFrom ))
|
||||
, ("registered", SortColumn $ queryExam >>> (\exam ->
|
||||
E.exists $ E.from $ \registration -> do
|
||||
E.where_ $ registration E.^. ExamRegistrationUser E.==. E.val uid
|
||||
E.where_ $ registration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
|
||||
))
|
||||
]
|
||||
dbtFilter = Map.empty
|
||||
dbtFilterUI = const mempty
|
||||
dbtStyle = def
|
||||
dbtParams = def
|
||||
dbtIdent :: Text
|
||||
dbtIdent = "exams"
|
||||
dbtCsvEncode = noCsvEncode
|
||||
dbtCsvDecode = Nothing
|
||||
|
||||
examDBTableValidator = def
|
||||
& defaultSorting [SortAscBy "time"]
|
||||
(Any hasExams, examTable) <- dbTable examDBTableValidator examDBTable
|
||||
return $(widgetFile "home/upcomingExams")
|
||||
examDBTableValidator = def
|
||||
& defaultSorting [SortAscBy "time"]
|
||||
|
||||
(, userWarningDays) <$> dbTable examDBTableValidator examDBTable
|
||||
|
||||
$(widgetFile "home/upcomingExams")
|
||||
|
||||
|
||||
|
||||
@ -14,7 +14,6 @@ import qualified Data.Conduit.List as C
|
||||
import qualified Database.Esqueleto as E
|
||||
import Database.Esqueleto.Utils.TH
|
||||
|
||||
import Utils.Lens
|
||||
import Utils.Form
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Delete
|
||||
|
||||
@ -5,7 +5,6 @@ import Import
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Table.Cells
|
||||
|
||||
import Utils.Lens
|
||||
-- import Colonnade hiding (fromMaybe, singleton)
|
||||
-- import Yesod.Colonnade
|
||||
import Data.Monoid (Any(..))
|
||||
@ -16,6 +15,7 @@ import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
-- import Database.Esqueleto ((^.))
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
|
||||
data SettingsForm = SettingsForm
|
||||
@ -25,15 +25,32 @@ data SettingsForm = SettingsForm
|
||||
, stgDate :: DateTimeFormat
|
||||
, stgTime :: DateTimeFormat
|
||||
, stgDownloadFiles :: Bool
|
||||
, stgWarningDays :: NominalDiffTime
|
||||
, stgSchools :: Set SchoolId
|
||||
, stgNotificationSettings :: NotificationSettings
|
||||
}
|
||||
|
||||
data NotificationTriggerKind = NTKAll | NTKCourseParticipant | NTKExamParticipant | NTKCorrector | NTKLecturer | NTKAdmin
|
||||
deriving (Eq, Ord, Enum, Bounded, Generic, Typeable)
|
||||
instance Universe NotificationTriggerKind
|
||||
instance Finite NotificationTriggerKind
|
||||
data NotificationTriggerKind
|
||||
= NTKAll
|
||||
| NTKCourseParticipant
|
||||
| NTKExamParticipant
|
||||
| NTKCorrector
|
||||
| NTKFunctionary SchoolFunction
|
||||
deriving (Eq, Ord, Generic, Typeable)
|
||||
deriveFinite ''NotificationTriggerKind
|
||||
|
||||
embedRenderMessage ''UniWorX ''NotificationTriggerKind $ ("NotificationTriggerKind" <>) . mconcat . drop 1 . splitCamel
|
||||
instance RenderMessage UniWorX NotificationTriggerKind where
|
||||
renderMessage f ls = \case
|
||||
NTKAll -> mr MsgNotificationTriggerKindAll
|
||||
NTKCourseParticipant -> mr MsgNotificationTriggerKindCourseParticipant
|
||||
NTKExamParticipant -> mr MsgNotificationTriggerKindExamParticipant
|
||||
NTKCorrector -> mr MsgNotificationTriggerKindCorrector
|
||||
NTKFunctionary SchoolAdmin -> mr MsgNotificationTriggerKindAdmin
|
||||
NTKFunctionary SchoolLecturer -> mr MsgNotificationTriggerKindLecturer
|
||||
NTKFunctionary SchoolExamOffice -> mr MsgNotificationTriggerKindExamOffice
|
||||
NTKFunctionary SchoolEvaluation -> mr MsgNotificationTriggerKindEvaluation
|
||||
where
|
||||
mr = renderMessage f ls
|
||||
|
||||
|
||||
makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
|
||||
@ -51,39 +68,40 @@ makeSettingForm template html = do
|
||||
<*> apopt checkBoxField (fslI MsgDownloadFiles
|
||||
& setTooltip MsgDownloadFilesTip
|
||||
) (stgDownloadFiles <$> template)
|
||||
<*> areq daysField (fslI MsgWarningDays
|
||||
& setTooltip MsgWarningDaysTip
|
||||
) (stgWarningDays <$> template)
|
||||
<* aformSection MsgFormNotifications
|
||||
<*> schoolsForm (stgSchools <$> template)
|
||||
<*> notificationForm (stgNotificationSettings <$> template)
|
||||
return (result, widget) -- no validation required here
|
||||
where
|
||||
themeList = [Option (toMessage t) t (toPathPiece t) | t <- universeF]
|
||||
--
|
||||
-- Version with proper grouping:
|
||||
--
|
||||
-- makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
|
||||
-- makeSettingForm template = identForm FIDsettings $ \html -> do
|
||||
-- (result, widget) <- flip (renderAForm FormStandard) html $ settingsFormT5T2
|
||||
-- <$> aFormGroup "Cosmetics" cosmeticsForm
|
||||
-- <*> aFormGroup "Notifications" notificationsForm
|
||||
-- <* submitButton
|
||||
-- return (result, widget) -- no validation required here
|
||||
-- where
|
||||
-- settingsFormT5T2 :: (Int,Theme,DateTimeFormat,DateTimeFormat,DateTimeFormat) -> (Bool,NotificationSettings) -> SettingsForm
|
||||
-- settingsFormT5T2 = $(uncurryN 2) . $(uncurryN 5) SettingsForm
|
||||
-- themeList = [Option (display t) t (toPathPiece t) | t <- universeF]
|
||||
-- cosmeticsForm = (,,,,)
|
||||
-- <$> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here
|
||||
-- (fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template)
|
||||
-- <*> areq (selectField . return $ mkOptionList themeList)
|
||||
-- (fslI MsgTheme) { fsId = Just "theme-select" } (stgTheme <$> template)
|
||||
-- <*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
|
||||
-- <*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template)
|
||||
-- <*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template)
|
||||
-- notificationsForm = (,)
|
||||
-- <$> areq checkBoxField (fslI MsgDownloadFiles
|
||||
-- & setTooltip MsgDownloadFilesTip
|
||||
-- ) (stgDownloadFiles <$> template)
|
||||
-- <*> (NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True)
|
||||
-- nsForm nt = fromMaybe False <$> aopt checkBoxField (fslI nt) (Just $ flip notificationAllowed nt . stgNotificationSettings <$> template)
|
||||
|
||||
schoolsForm :: Maybe (Set SchoolId) -> AForm Handler (Set SchoolId)
|
||||
schoolsForm template = formToAForm $ schoolsFormView =<< renderWForm FormStandard schoolsForm' mempty
|
||||
where
|
||||
schoolsForm' :: WForm Handler (FormResult (Set SchoolId))
|
||||
schoolsForm' = do
|
||||
allSchools <- liftHandlerT . runDB $ selectList [] [Asc SchoolName]
|
||||
|
||||
let
|
||||
schoolForm (Entity ssh School{schoolName})
|
||||
= fmap (bool Set.empty $ Set.singleton ssh) <$> wpopt checkBoxField (fsl $ CI.original schoolName) (Set.member ssh <$> template)
|
||||
|
||||
fold <$> mapM schoolForm allSchools
|
||||
|
||||
schoolsFormView :: (FormResult (Set SchoolId), Widget) -> MForm Handler (FormResult (Set SchoolId), [FieldView UniWorX])
|
||||
schoolsFormView (res, fvInput) = do
|
||||
mr <- getMessageRender
|
||||
let fvLabel = toHtml $ mr MsgUserSchools
|
||||
fvTooltip = Just . toHtml $ mr MsgUserSchoolsTip
|
||||
fvRequired = False
|
||||
fvErrors
|
||||
| FormFailure (err : _) <- res = Just $ toHtml err
|
||||
| otherwise = Nothing
|
||||
fvId <- newIdent
|
||||
return (res, pure FieldView{..})
|
||||
|
||||
notificationForm :: Maybe NotificationSettings -> AForm Handler NotificationSettings
|
||||
notificationForm template = wFormToAForm $ do
|
||||
@ -96,13 +114,10 @@ notificationForm template = wFormToAForm $ do
|
||||
| isAdmin
|
||||
= return False
|
||||
| Just uid <- mbUid
|
||||
, NTKAdmin <- nt
|
||||
= fmap not . E.selectExists . E.from $ \userAdmin ->
|
||||
E.where_ $ userAdmin E.^. UserAdminUser E.==. E.val uid
|
||||
| Just uid <- mbUid
|
||||
, NTKLecturer <- nt
|
||||
= fmap not . E.selectExists . E.from $ \userLecturer ->
|
||||
E.where_ $ userLecturer E.^. UserLecturerUser E.==. E.val uid
|
||||
, NTKFunctionary f <- nt
|
||||
= fmap not . E.selectExists . E.from $ \userFunction ->
|
||||
E.where_ $ userFunction E.^. UserFunctionUser E.==. E.val uid
|
||||
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val f
|
||||
| Just uid <- mbUid
|
||||
, NTKCorrector <- nt
|
||||
= fmap not . E.selectExists . E.from $ \sheetCorrector ->
|
||||
@ -138,9 +153,9 @@ notificationForm template = wFormToAForm $ do
|
||||
NTSubmissionRated -> Just NTKCourseParticipant
|
||||
NTSheetActive -> Just NTKCourseParticipant
|
||||
NTSheetSoonInactive -> Just NTKCourseParticipant
|
||||
NTSheetInactive -> Just NTKLecturer
|
||||
NTSheetInactive -> Just $ NTKFunctionary SchoolLecturer
|
||||
NTCorrectionsAssigned -> Just NTKCorrector
|
||||
NTCorrectionsNotDistributed -> Just NTKLecturer
|
||||
NTCorrectionsNotDistributed -> Just $ NTKFunctionary SchoolLecturer
|
||||
NTUserRightsUpdate -> Just NTKAll
|
||||
NTUserAuthModeUpdate -> Just NTKAll
|
||||
NTExamResult -> Just NTKExamParticipant
|
||||
@ -174,6 +189,12 @@ getProfileR, postProfileR :: Handler Html
|
||||
getProfileR = postProfileR
|
||||
postProfileR = do
|
||||
(uid, User{..}) <- requireAuthPair
|
||||
userSchools <- fmap (setOf $ folded . _Value) . runDB . E.select . E.from $ \school -> do
|
||||
E.where_ . E.exists . E.from $ \userSchool ->
|
||||
E.where_ $ E.not_ (userSchool E.^. UserSchoolIsOptOut)
|
||||
E.&&. userSchool E.^. UserSchoolUser E.==. E.val uid
|
||||
E.&&. userSchool E.^. UserSchoolSchool E.==. school E.^. SchoolId
|
||||
return $ school E.^. SchoolId
|
||||
let settingsTemplate = Just SettingsForm
|
||||
{ stgMaxFavourties = userMaxFavourites
|
||||
, stgTheme = userTheme
|
||||
@ -181,7 +202,9 @@ postProfileR = do
|
||||
, stgDate = userDateFormat
|
||||
, stgTime = userTimeFormat
|
||||
, stgDownloadFiles = userDownloadFiles
|
||||
, stgSchools = userSchools
|
||||
, stgNotificationSettings = userNotificationSettings
|
||||
, stgWarningDays = userWarningDays
|
||||
}
|
||||
((res,formWidget), formEnctype) <- runFormPost . identifyForm ProfileSettings $ makeSettingForm settingsTemplate
|
||||
|
||||
@ -193,6 +216,7 @@ postProfileR = do
|
||||
, UserDateFormat =. stgDate
|
||||
, UserTimeFormat =. stgTime
|
||||
, UserDownloadFiles =. stgDownloadFiles
|
||||
, UserWarningDays =. stgWarningDays
|
||||
, UserNotificationSettings =. stgNotificationSettings
|
||||
]
|
||||
when (stgMaxFavourties < userMaxFavourites) $ do
|
||||
@ -202,6 +226,25 @@ postProfileR = do
|
||||
, OffsetBy stgMaxFavourties
|
||||
]
|
||||
mapM_ delete oldFavs
|
||||
let
|
||||
symDiff = (stgSchools `Set.difference` userSchools) `Set.union` (userSchools `Set.difference` stgSchools)
|
||||
forM_ symDiff $ \ssh -> if
|
||||
| ssh `Set.member` stgSchools
|
||||
-> void $ upsert UserSchool
|
||||
{ userSchoolSchool = ssh
|
||||
, userSchoolUser = uid
|
||||
, userSchoolIsOptOut = False
|
||||
}
|
||||
[ UserSchoolIsOptOut =. False
|
||||
]
|
||||
| otherwise
|
||||
-> void $ upsert UserSchool
|
||||
{ userSchoolSchool = ssh
|
||||
, userSchoolUser = uid
|
||||
, userSchoolIsOptOut = True
|
||||
}
|
||||
[ UserSchoolIsOptOut =. True
|
||||
]
|
||||
addMessageI Info MsgSettingsUpdate
|
||||
redirect $ ProfileR :#: ProfileSettings
|
||||
|
||||
@ -250,14 +293,7 @@ getProfileDataR = do
|
||||
makeProfileData :: Entity User -> DB Widget
|
||||
makeProfileData (Entity uid User{..}) = do
|
||||
-- MsgRenderer mr <- getMsgRenderer
|
||||
admin_rights <- E.select $ E.from $ \(adright `E.InnerJoin` school) -> do
|
||||
E.where_ $ adright E.^. UserAdminUser E.==. E.val uid
|
||||
E.on $ adright E.^. UserAdminSchool E.==. school E.^. SchoolId
|
||||
return (school E.^. SchoolShorthand)
|
||||
lecturer_rights <- E.select $ E.from $ \(lecright `E.InnerJoin` school) -> do
|
||||
E.where_ $ lecright E.^. UserLecturerUser E.==. E.val uid
|
||||
E.on $ lecright E.^. UserLecturerSchool E.==. school E.^. SchoolId
|
||||
return (school E.^. SchoolShorthand)
|
||||
functions <- Map.fromListWith Set.union . map (\(Entity _ UserFunction{..}) -> (userFunctionFunction, Set.singleton userFunctionSchool)) <$> selectList [UserFunctionUser ==. uid] []
|
||||
lecture_corrector <- 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.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
|
||||
@ -309,7 +345,7 @@ mkOwnedCoursesTable =
|
||||
return $ indicatorCell -- return True if one cell is produced here
|
||||
`mappend` termCell tid
|
||||
, sortable (Just "school") (i18nCell MsgCourseSchool) $
|
||||
schoolCell <$> view (_dbrOutput . _1 . re _Just)
|
||||
schoolCell <$> view (_dbrOutput . _1)
|
||||
<*> view (_dbrOutput . _2 )
|
||||
, sortable (Just "course") (i18nCell MsgCourse) $
|
||||
courseCellCL <$> view _dbrOutput
|
||||
@ -357,8 +393,8 @@ mkEnrolledCoursesTable =
|
||||
, 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
|
||||
schoolCell <$> view _courseTerm
|
||||
<*> view _courseSchool
|
||||
, sortable (Just "course") (i18nCell MsgCourse) $
|
||||
courseCell <$> view (_dbrOutput . _1 . _entityVal)
|
||||
, sortable (Just "time") (i18nCell MsgRegistered) $ do
|
||||
@ -425,7 +461,7 @@ mkSubmissionTable =
|
||||
, sortable (Just "term") (i18nCell MsgTerm) $
|
||||
termCell <$> view (_dbrOutput . _1 . _1)
|
||||
, sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 ) $
|
||||
schoolCell <$> view ( _1. re _Just)
|
||||
schoolCell <$> view _1
|
||||
<*> view _2
|
||||
, sortable (Just "course") (i18nCell MsgCourse) $
|
||||
courseCellCL <$> view (_dbrOutput . _1)
|
||||
@ -507,7 +543,7 @@ mkSubmissionGroupTable =
|
||||
, sortable (Just "term") (i18nCell MsgTerm) $
|
||||
termCell <$> view (_dbrOutput . _1 . _1)
|
||||
, sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 ) $
|
||||
schoolCell <$> view ( _1. re _Just)
|
||||
schoolCell <$> view _1
|
||||
<*> view _2
|
||||
, sortable (Just "course") (i18nCell MsgCourse) $
|
||||
courseCellCL <$> view (_dbrOutput . _1)
|
||||
|
||||
@ -1,10 +1,169 @@
|
||||
module Handler.School where
|
||||
|
||||
import Import
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Table.Columns
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.Text as Text
|
||||
|
||||
|
||||
getSchoolListR :: Handler Html
|
||||
getSchoolListR = error "getSchoolListR: Not implemented"
|
||||
getSchoolListR = do
|
||||
let
|
||||
schoolLink :: SchoolId -> SomeRoute UniWorX
|
||||
schoolLink ssh = SomeRoute $ SchoolR ssh SchoolEditR
|
||||
|
||||
dbtSQLQuery :: E.SqlExpr (Entity School) -> E.SqlQuery _
|
||||
dbtSQLQuery = return
|
||||
|
||||
getSchoolShowR :: SchoolId -> Handler Html
|
||||
getSchoolShowR = error "getSchoolShowR: Not implemented"
|
||||
dbtProj :: DBRow _ -> MaybeT (YesodDB UniWorX) (DBRow (Entity School))
|
||||
dbtProj = return
|
||||
|
||||
dbtRowKey = (E.^. SchoolId)
|
||||
|
||||
dbtColonnade :: Colonnade Sortable _ _
|
||||
dbtColonnade = mconcat
|
||||
[ colSchoolShort $ _dbrOutput . _entityKey
|
||||
, anchorColonnade (views (_dbrOutput . _entityKey) schoolLink) $ colSchoolName (_dbrOutput . _entityVal . _schoolName)
|
||||
]
|
||||
|
||||
dbtSorting = mconcat
|
||||
[ sortSchoolShort $ to (E.^. SchoolId)
|
||||
, sortSchoolName $ to (E.^. SchoolName)
|
||||
]
|
||||
|
||||
dbtFilter = mempty
|
||||
dbtFilterUI = mempty
|
||||
|
||||
dbtStyle = def
|
||||
dbtParams = def
|
||||
|
||||
dbtCsvEncode = noCsvEncode
|
||||
dbtCsvDecode = Nothing
|
||||
|
||||
dbtIdent :: Text
|
||||
dbtIdent = "schools"
|
||||
|
||||
psValidator = def
|
||||
& defaultSorting [SortAscBy "school-name"]
|
||||
|
||||
|
||||
table <- runDB $ dbTableWidget' psValidator DBTable{..}
|
||||
|
||||
let title = MsgMenuSchoolList
|
||||
siteLayoutMsg title $ do
|
||||
setTitleI title
|
||||
table
|
||||
|
||||
data SchoolForm = SchoolForm
|
||||
{ sfShorthand :: CI Text
|
||||
, sfName :: CI Text
|
||||
, sfOrgUnits :: Set (CI Text)
|
||||
}
|
||||
|
||||
mkSchoolForm :: Maybe SchoolId -> Maybe SchoolForm -> Form SchoolForm
|
||||
mkSchoolForm mSsh template = renderAForm FormStandard $ SchoolForm
|
||||
<$> maybe (\f fs -> areq f fs (sfShorthand <$> template)) (\ssh f fs -> aforced f fs (unSchoolKey ssh)) mSsh ciField (fslI MsgSchoolShort)
|
||||
<*> areq ciField (fslI MsgSchoolName) (sfName <$> template)
|
||||
<*> (Set.fromList . mapMaybe (fmap CI.mk . assertM' (not . Text.null) . Text.strip) <$> massInputListA (textField & addDatalist ldapOrgs) (const "") (const Nothing) ("ldap-organisations" :: Text) (fslI MsgSchoolLdapOrganisations & setTooltip MsgSchoolLdapOrganisationsTip) False (fmap CI.original . Set.toList . sfOrgUnits <$> template))
|
||||
where
|
||||
ldapOrgs :: WidgetT UniWorX IO (Set (CI Text))
|
||||
ldapOrgs = liftHandlerT . runDB $
|
||||
setOf (folded . _entityVal . _schoolLdapOrgUnit) <$> selectList [] []
|
||||
|
||||
schoolToForm :: SchoolId -> DB (Form SchoolForm)
|
||||
schoolToForm ssh = do
|
||||
School{..} <- get404 ssh
|
||||
ldapFrags <- selectList [SchoolLdapSchool ==. Just ssh] []
|
||||
return . mkSchoolForm (Just ssh) $ Just SchoolForm
|
||||
{ sfShorthand = schoolShorthand
|
||||
, sfName = schoolName
|
||||
, sfOrgUnits = setOf (folded . _entityVal . _schoolLdapOrgUnit) ldapFrags
|
||||
}
|
||||
|
||||
|
||||
getSchoolEditR, postSchoolEditR :: SchoolId -> Handler Html
|
||||
getSchoolEditR = postSchoolEditR
|
||||
postSchoolEditR ssh = do
|
||||
sForm <- runDB $ schoolToForm ssh
|
||||
|
||||
((sfResult, sfView), sfEnctype) <- runFormPost sForm
|
||||
|
||||
formResult sfResult $ \SchoolForm{..} -> do
|
||||
runDB $ do
|
||||
update ssh [ SchoolName =. sfName ]
|
||||
forM_ sfOrgUnits $ \schoolLdapOrgUnit ->
|
||||
void $ upsert SchoolLdap
|
||||
{ schoolLdapSchool = Just ssh
|
||||
, ..
|
||||
}
|
||||
[ SchoolLdapSchool =. Just ssh
|
||||
]
|
||||
deleteWhere [SchoolLdapSchool ==. Just ssh, SchoolLdapOrgUnit /<-. Set.toList sfOrgUnits]
|
||||
addMessageI Success $ MsgSchoolUpdated ssh
|
||||
redirect $ SchoolR ssh SchoolEditR
|
||||
|
||||
let sfView' = wrapForm sfView FormSettings
|
||||
{ formMethod = POST
|
||||
, formAction = Just . SomeRoute $ SchoolR ssh SchoolEditR
|
||||
, formEncoding = sfEnctype
|
||||
, formAttrs = []
|
||||
, formSubmit = FormSubmit
|
||||
, formAnchor = Nothing :: Maybe Text
|
||||
}
|
||||
|
||||
siteLayoutMsg (MsgSchoolTitle ssh) $ do
|
||||
setTitleI $ MsgSchoolTitle ssh
|
||||
sfView'
|
||||
|
||||
getSchoolNewR, postSchoolNewR :: Handler Html
|
||||
getSchoolNewR = postSchoolNewR
|
||||
postSchoolNewR = do
|
||||
uid <- requireAuthId
|
||||
((sfResult, sfView), sfEnctype) <- runFormPost $ mkSchoolForm Nothing Nothing
|
||||
|
||||
formResult sfResult $ \SchoolForm{..} -> do
|
||||
let ssh = SchoolKey sfShorthand
|
||||
insertOkay <- runDB $ do
|
||||
didInsert <- is _Just <$> insertUnique School
|
||||
{ schoolShorthand = sfShorthand
|
||||
, schoolName = sfName
|
||||
}
|
||||
when didInsert $ do
|
||||
insert_ UserFunction
|
||||
{ userFunctionUser = uid
|
||||
, userFunctionSchool = ssh
|
||||
, userFunctionFunction = SchoolAdmin
|
||||
}
|
||||
forM_ sfOrgUnits $ \schoolLdapOrgUnit ->
|
||||
void $ upsert SchoolLdap
|
||||
{ schoolLdapSchool = Just ssh
|
||||
, ..
|
||||
}
|
||||
[ SchoolLdapSchool =. Just ssh
|
||||
]
|
||||
return didInsert
|
||||
|
||||
if
|
||||
| insertOkay -> do
|
||||
addMessageI Success $ MsgSchoolCreated ssh
|
||||
redirect $ SchoolR ssh SchoolEditR
|
||||
| otherwise
|
||||
-> addMessageI Error $ MsgSchoolExists ssh
|
||||
|
||||
let sfView' = wrapForm sfView FormSettings
|
||||
{ formMethod = POST
|
||||
, formAction = Just $ SomeRoute SchoolNewR
|
||||
, formEncoding = sfEnctype
|
||||
, formAttrs = []
|
||||
, formSubmit = FormSubmit
|
||||
, formAnchor = Nothing :: Maybe Text
|
||||
}
|
||||
|
||||
siteLayoutMsg MsgTitleSchoolNew $ do
|
||||
setTitleI MsgTitleSchoolNew
|
||||
sfView'
|
||||
|
||||
@ -49,11 +49,6 @@ import Data.Map (Map, (!))
|
||||
|
||||
import Data.Monoid (Any(..))
|
||||
|
||||
-- import Control.Lens
|
||||
import Utils.Lens
|
||||
|
||||
--import qualified Data.Aeson as Aeson
|
||||
|
||||
import Control.Monad.Random.Class (MonadRandom(..))
|
||||
import Utils.Sql
|
||||
|
||||
@ -186,7 +181,7 @@ getSheetListR tid ssh csh = do
|
||||
let
|
||||
hasSFT :: (E.Value Bool, E.Value Bool, E.Value Bool, E.Value Bool) -> [SheetFileType]
|
||||
hasSFT (E.Value hasExercise, E.Value hasHint, E.Value hasSolution, E.Value hasMarking)
|
||||
= [ sft | sft <- [minBound..maxBound]
|
||||
= [ sft | sft <- universeF
|
||||
, sft /= SheetExercise || hasExercise
|
||||
, sft /= SheetHint || hasHint
|
||||
, sft /= SheetSolution || hasSolution
|
||||
@ -204,7 +199,7 @@ getSheetListR tid ssh csh = do
|
||||
E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
|
||||
|
||||
sheetFilter :: SheetName -> DB Bool
|
||||
sheetFilter sheetName = (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh sheetName SShowR) False
|
||||
sheetFilter sheetName = hasReadAccessTo $ CSheetR tid ssh csh sheetName SShowR
|
||||
|
||||
sheetCol = widgetColonnade . mconcat $
|
||||
[ -- dbRow ,
|
||||
@ -220,9 +215,9 @@ getSheetListR tid ssh csh = do
|
||||
| let existingSFTs = hasSFT existFiles
|
||||
, sft <- [minBound..maxBound]
|
||||
, let link = CSheetR tid ssh csh sheetName $ SZipR sft
|
||||
, let icn = toWidget $ sheetFile2markup sft
|
||||
, let icn = toWgt $ sheetFile2markup sft
|
||||
, let icnCell = if sft `elem` existingSFTs
|
||||
then linkEmptyCell link icn
|
||||
then linkEitherCell link (icn, [whamlet| |])
|
||||
else spacerCell
|
||||
] id & cellAttrs <>~ [("class","list--inline list--space-separated")]
|
||||
, sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom)
|
||||
@ -726,7 +721,7 @@ correctorForm shid = wFormToAForm $ do
|
||||
-- when (not (Map.null loads) && applyDefaultLoads) $ -- Alert Message
|
||||
-- addMessageI Warning MsgCorrectorsDefaulted
|
||||
when (not (Map.null loads) && applyDefaultLoads) $ -- Alert Notification
|
||||
wformMessage =<< messageI Warning MsgCorrectorsDefaulted
|
||||
wformMessage =<< messageIconI Warning IconNoCorrectors MsgCorrectorsDefaulted
|
||||
|
||||
|
||||
let
|
||||
@ -907,7 +902,7 @@ correctorInvitationConfig = InvitationConfig{..}
|
||||
Course{..} <- get404 sheetCourse
|
||||
return . SomeMessage $ MsgMailSubjectCorrectorInvitation courseTerm courseSchool courseShorthand sheetName
|
||||
invitationHeading (Entity _ Sheet{..}) _ = return . SomeMessage $ MsgSheetCorrInviteHeading sheetName
|
||||
invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgSheetCorrInviteExplanation}|]
|
||||
invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgSheetCorrInviteExplanation}|]
|
||||
invitationTokenConfig _ _ = do
|
||||
itAuthority <- liftHandlerT requireAuthId
|
||||
return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
|
||||
|
||||
@ -6,8 +6,6 @@ import Import
|
||||
|
||||
import Jobs
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
-- import Yesod.Form.Bootstrap3
|
||||
|
||||
import Handler.Utils
|
||||
@ -102,7 +100,7 @@ submissionUserInvitationConfig = InvitationConfig{..}
|
||||
invitationHeading (Entity _ Submission{..}) _ = do
|
||||
Sheet{..} <- getJust submissionSheet
|
||||
return . SomeMessage $ MsgSubmissionUserInviteHeading sheetName
|
||||
invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgSubmissionUserInviteExplanation}|]
|
||||
invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgSubmissionUserInviteExplanation}|]
|
||||
invitationTokenConfig (Entity _ Submission{..}) _ = do
|
||||
Sheet{..} <- getJust submissionSheet
|
||||
Course{..} <- getJust sheetCourse
|
||||
|
||||
@ -11,8 +11,6 @@ import qualified Data.List.NonEmpty as NonEmpty
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Table.Cells
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
|
||||
-- htmlField' moved to Handler.Utils.Form/Fields
|
||||
|
||||
@ -5,8 +5,6 @@ import Handler.Utils
|
||||
import Handler.Utils.Table.Cells
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
|
||||
import qualified Data.Set as Set
|
||||
@ -259,7 +257,14 @@ newTermForm template html = do
|
||||
= aforced termNewField (fslpI MsgTerm (mr MsgTermPlaceholder)) tid
|
||||
| otherwise
|
||||
= areq termNewField (fslpI MsgTerm (mr MsgTermPlaceholder)) Nothing
|
||||
holidayForm = formToAForm . over (mapped._2) pure $ massInputList dayField (const $ "" & addPlaceholder (mr MsgTermHolidayPlaceholder)) (const Nothing) ("holidays" :: Text) (fslI MsgTermHolidays & setTooltip MsgMassInputTip) True (tftHolidays template) mempty
|
||||
holidayForm = massInputListA
|
||||
dayField
|
||||
(const $ "" & addPlaceholder (mr MsgTermHolidayPlaceholder))
|
||||
(const Nothing)
|
||||
("holidays" :: Text)
|
||||
(fslI MsgTermHolidays & setTooltip MsgMassInputTip)
|
||||
True
|
||||
(tftHolidays template)
|
||||
(result, widget) <- flip (renderAForm FormStandard) html $ Term
|
||||
<$> tidForm
|
||||
<*> areq dayField (fslI MsgTermStartDay & setTooltip MsgTermStartDayTooltip) (tftStart template)
|
||||
|
||||
@ -25,8 +25,6 @@ import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import qualified Data.Text as Text
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import Data.Aeson hiding (Result(..))
|
||||
import Text.Hamlet (ihamlet)
|
||||
|
||||
@ -260,7 +258,7 @@ tutorInvitationConfig = InvitationConfig{..}
|
||||
Course{..} <- get404 tutorialCourse
|
||||
return . SomeMessage $ MsgMailSubjectTutorInvitation courseTerm courseSchool courseShorthand tutorialName
|
||||
invitationHeading (Entity _ Tutorial{..}) _ = return . SomeMessage $ MsgTutorInviteHeading tutorialName
|
||||
invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgTutorInviteExplanation}|]
|
||||
invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgTutorInviteExplanation}|]
|
||||
invitationTokenConfig _ _ = do
|
||||
itAuthority <- liftHandlerT requireAuthId
|
||||
return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
|
||||
|
||||
@ -4,7 +4,6 @@ module Handler.Tutorial.Users
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Lens
|
||||
import Utils.Form
|
||||
-- import Utils.DB
|
||||
import Handler.Utils
|
||||
|
||||
@ -13,8 +13,6 @@ import Handler.Utils.Invitations
|
||||
|
||||
import qualified Auth.LDAP as Auth
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import qualified Data.Set as Set
|
||||
@ -60,30 +58,20 @@ getUsersR = do
|
||||
-- (AdminUserR <$> encrypt uid)
|
||||
-- (toWidget . display $ last $ impureNonNull $ words $ userDisplayName)
|
||||
, sortable (Just "auth-ldap") (i18nCell MsgAuthMode) $ \DBRow{ dbrOutput = Entity _ User{..} } -> i18nCell userAuthentication
|
||||
, sortable Nothing (i18nCell MsgAdminFor) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do
|
||||
schools <- lift . E.select . E.from $ \(school `E.InnerJoin` userAdmin) -> do
|
||||
E.on $ school E.^. SchoolId E.==. userAdmin E.^. UserAdminSchool
|
||||
E.where_ $ userAdmin E.^. UserAdminUser E.==. E.val uid
|
||||
E.orderBy [E.asc $ school E.^. SchoolShorthand]
|
||||
return $ school E.^. SchoolShorthand
|
||||
return [whamlet|
|
||||
$newline never
|
||||
<ul .list--inline .list--comma-separated>
|
||||
$forall (E.Value sh) <- schools
|
||||
<li>#{sh}
|
||||
|]
|
||||
, sortable Nothing (i18nCell MsgLecturerFor) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do
|
||||
schools <- lift . E.select . E.from $ \(school `E.InnerJoin` userLecturer) -> do
|
||||
E.on $ school E.^. SchoolId E.==. userLecturer E.^. UserLecturerSchool
|
||||
E.where_ $ userLecturer E.^. UserLecturerUser E.==. E.val uid
|
||||
E.orderBy [E.asc $ school E.^. SchoolShorthand]
|
||||
return $ school E.^. SchoolShorthand
|
||||
return [whamlet|
|
||||
$newline never
|
||||
<ul .list--inline .list--comma-separated>
|
||||
$forall (E.Value sh) <- schools
|
||||
<li>#{sh}
|
||||
|]
|
||||
, flip foldMap universeF $ \function ->
|
||||
sortable Nothing (i18nCell function) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do
|
||||
schools <- lift . E.select . E.from $ \(school `E.InnerJoin` userFunction) -> do
|
||||
E.on $ school E.^. SchoolId E.==. userFunction E.^. UserFunctionSchool
|
||||
E.where_ $ userFunction E.^. UserFunctionUser E.==. E.val uid
|
||||
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val function
|
||||
E.orderBy [E.asc $ school E.^. SchoolShorthand]
|
||||
return $ school E.^. SchoolShorthand
|
||||
return [whamlet|
|
||||
$newline never
|
||||
<ul .list--inline .list--comma-separated>
|
||||
$forall (E.Value sh) <- schools
|
||||
<li>#{sh}
|
||||
|]
|
||||
, sortable Nothing mempty $ \DBRow{ dbrOutput = Entity uid _ } -> cell $ do
|
||||
cID <- encrypt uid
|
||||
mayHijack <- (== Authorized) <$> evalAccess (AdminHijackUserR cID) True
|
||||
@ -144,14 +132,8 @@ getUsersR = do
|
||||
, ( "school", FilterColumn $ \user criterion -> if
|
||||
| Set.null criterion -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
| otherwise -> let schools = E.valList (Set.toList criterion) in
|
||||
E.exists ( E.from $ \ulectr -> do
|
||||
E.where_ $ ulectr E.^. UserLecturerUser E.==. user E.^. UserId
|
||||
E.where_ $ ulectr E.^. UserLecturerSchool `E.in_` schools
|
||||
) E.||.
|
||||
E.exists ( E.from $ \uadmin -> do
|
||||
E.where_ $ uadmin E.^. UserAdminUser E.==. user E.^. UserId
|
||||
E.where_ $ uadmin E.^. UserAdminSchool `E.in_` schools
|
||||
)
|
||||
E.exists . E.from $ \ufunc -> E.where_ $ ufunc E.^. UserFunctionUser E.==. user E.^. UserId
|
||||
E.&&. ufunc E.^. UserFunctionFunction `E.in_` schools
|
||||
)
|
||||
]
|
||||
, dbtFilterUI = \mPrev -> mconcat
|
||||
@ -201,56 +183,57 @@ getAdminUserR = postAdminUserR
|
||||
postAdminUserR uuid = do
|
||||
adminId <- requireAuthId
|
||||
uid <- decrypt uuid
|
||||
let fromSchoolList = Set.fromList . map (userAdminSchool . entityVal)
|
||||
let unValueRights (school, E.Value isAdmin, E.Value isLecturer) = (school,isAdmin,isLecturer)
|
||||
(user@User{..}, fromSchoolList -> adminSchools, fmap unValueRights -> userRights) <- runDB $ (,,)
|
||||
<$> get404 uid
|
||||
<*> selectList [UserAdminUser ==. adminId] []
|
||||
<*> E.select ( E.from $ \school -> do
|
||||
E.orderBy [E.asc $ school E.^. SchoolName]
|
||||
let schAdmin = E.exists $ E.from $ \userAdmin -> do
|
||||
E.where_ $ userAdmin E.^. UserAdminSchool E.==. school E.^. SchoolId
|
||||
E.where_ $ userAdmin E.^. UserAdminUser E.==. E.val uid
|
||||
let schLecturer = E.exists $ E.from $ \userLecturer -> do
|
||||
E.where_ $ userLecturer E.^. UserLecturerSchool E.==. school E.^. SchoolId
|
||||
E.where_ $ userLecturer E.^. UserLecturerUser E.==. E.val uid
|
||||
return (school,schAdmin,schLecturer)
|
||||
)
|
||||
(user@User{..}, adminSchools, functions, schools) <- runDB $ do
|
||||
user <- get404 uid
|
||||
|
||||
schools <- E.select . E.from $ \(school `E.LeftOuterJoin` userFunction) -> do
|
||||
E.on $ userFunction E.?. UserFunctionSchool E.==. E.just (school E.^. SchoolId)
|
||||
E.&&. userFunction E.?. UserFunctionUser E.==. E.just (E.val uid)
|
||||
let isAdmin = E.exists . E.from $ \adminFunction ->
|
||||
E.where_ $ adminFunction E.^. UserFunctionUser E.==. E.val adminId
|
||||
E.&&. adminFunction E.^. UserFunctionSchool E.==. school E.^. SchoolId
|
||||
E.&&. adminFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin
|
||||
return (school, userFunction E.?. UserFunctionFunction, isAdmin)
|
||||
|
||||
return ( user
|
||||
, setOf (folded . filtered (view $ _3 . _Value) . _1 . _entityKey) schools
|
||||
, setOf (folded . folding (\x -> (,) <$> preview (_2 . _Value . _Just) x <*> preview (_1 . _entityKey) x)) schools
|
||||
, setOf (folded . _1) schools
|
||||
)
|
||||
let allFunctions = Set.fromList universeF
|
||||
allSchools = Set.mapMonotonic entityKey schools
|
||||
|
||||
-- above data is needed for both form generation and result evaluation
|
||||
let userRightsForm :: Form [(SchoolId, Bool, Bool)]
|
||||
let userRightsForm :: Form (Set (SchoolFunction, SchoolId))
|
||||
userRightsForm = identifyForm FIDuserRights $ \csrf -> do
|
||||
boxRights <- forM userRights $ \(school@(Entity sid _), isAdmin, isLecturer) ->
|
||||
if Set.member sid adminSchools
|
||||
then do
|
||||
cbAdmin <- mreq checkBoxField "" (Just isAdmin)
|
||||
cbLecturer <- mreq checkBoxField "" (Just isLecturer)
|
||||
return (school, cbAdmin, cbLecturer)
|
||||
else do
|
||||
cbAdmin <- mforced checkBoxField "" isAdmin
|
||||
cbLecturer <- mforced checkBoxField "" isLecturer
|
||||
return (school, cbAdmin, cbLecturer)
|
||||
let result = forM boxRights $ \(Entity sid _, (resAdmin,_), (resLecturer, _)) ->
|
||||
(,,) <$> pure sid <*> resAdmin <*> resLecturer
|
||||
return (result,$(widgetFile "widgets/user-rights-form/user-rights-form"))
|
||||
boxRights <- sequence . flip Map.fromSet (allFunctions `setProduct` allSchools) $ \(function, sid) -> if
|
||||
| sid `Set.member` adminSchools
|
||||
-> mpopt checkBoxField "" . Just $ (function, sid) `Set.member` functions
|
||||
| otherwise
|
||||
-> mforced checkBoxField "" $ (function, sid) `Set.member` functions
|
||||
let result = Map.keysSet . Map.filter id <$> mapM (view _1) boxRights
|
||||
return (result, $(widgetFile "widgets/user-rights-form/user-rights-form"))
|
||||
userAuthenticationForm :: Form ButtonAuthMode
|
||||
userAuthenticationForm = buttonForm' $ if
|
||||
| userAuthentication == AuthLDAP -> [BtnAuthPWHash]
|
||||
| otherwise -> [BtnAuthLDAP, BtnPasswordReset]
|
||||
let userRightsAction changes = do
|
||||
runDBJobs $ do
|
||||
forM_ changes $ \(sid, userAdmin, userLecturer) ->
|
||||
if Set.notMember sid adminSchools
|
||||
then return ()
|
||||
else do
|
||||
if userAdmin
|
||||
then void . insertUnique $ UserAdmin uid sid
|
||||
else deleteBy $ UniqueUserAdmin uid sid
|
||||
if userLecturer
|
||||
then void . insertUnique $ UserLecturer uid sid
|
||||
else deleteBy $ UniqueSchoolLecturer uid sid
|
||||
-- Note: deleteWhere would not work well here since we filter by adminSchools
|
||||
queueDBJob . JobQueueNotification $ NotificationUserRightsUpdate uid (over _1 (schoolShorthand . entityVal) <$> userRights) -- original rights to check for difference
|
||||
addMessageI Info MsgAccessRightsSaved
|
||||
let symDiff = (changes `Set.difference` functions) `Set.union` (functions `Set.difference` changes)
|
||||
updates = (allFunctions `setProduct` adminSchools) `Set.intersection` symDiff
|
||||
if
|
||||
| not $ Set.null updates -> runDBJobs $ do
|
||||
$logInfoS "user-rights-update" $ tshow updates
|
||||
forM_ updates $ \(function, sid) -> do
|
||||
$logDebugS "user-rights-update" [st|#{tshow (function, sid)}: #{tshow (Set.member (function, sid) functions)} → #{tshow (Set.member (function,sid) changes)}|]
|
||||
if
|
||||
| (function, sid) `Set.member` changes
|
||||
-> void . insertUnique $ UserFunction uid sid function
|
||||
| otherwise
|
||||
-> deleteBy $ UniqueUserFunction uid sid function
|
||||
queueDBJob . JobQueueNotification . NotificationUserRightsUpdate uid $ Set.mapMonotonic (over _2 unSchoolKey) functions -- original rights to check for difference
|
||||
addMessageI Success MsgAccessRightsSaved
|
||||
| otherwise
|
||||
-> addMessageI Info MsgAccessRightsNotChanged
|
||||
redirect $ AdminUserR uuid
|
||||
|
||||
userAuthenticationAction = \case
|
||||
@ -437,54 +420,76 @@ postUserPasswordR cID = do
|
||||
}
|
||||
|
||||
|
||||
instance IsInvitableJunction UserLecturer where
|
||||
type InvitationFor UserLecturer = School
|
||||
data InvitableJunction UserLecturer = JunctionUserLecturer
|
||||
instance IsInvitableJunction UserFunction where
|
||||
type InvitationFor UserFunction = School
|
||||
data InvitableJunction UserFunction = JunctionUserFunction
|
||||
{ jFunction :: SchoolFunction
|
||||
}
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
data InvitationDBData UserLecturer = InvDBDataUserLecturer
|
||||
data InvitationDBData UserFunction = InvDBDataUserFunction
|
||||
{ invDBUserFunctionDeadline :: UTCTime
|
||||
}
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
data InvitationTokenData UserLecturer = InvTokenDataUserLecturer
|
||||
{ invTokenUserLecturerSchool :: SchoolShorthand
|
||||
data InvitationTokenData UserFunction = InvTokenDataUserFunction
|
||||
{ invTokenUserFunctionSchool :: SchoolShorthand
|
||||
, invTokenUserFunctionFunction :: SchoolFunction
|
||||
}
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
|
||||
_InvitableJunction = iso
|
||||
(\UserLecturer{..} -> (userLecturerUser, userLecturerSchool, JunctionUserLecturer))
|
||||
(\(userLecturerUser, userLecturerSchool, JunctionUserLecturer) -> UserLecturer{..})
|
||||
(\UserFunction{..} -> (userFunctionUser, userFunctionSchool, JunctionUserFunction userFunctionFunction))
|
||||
(\(userFunctionUser, userFunctionSchool, JunctionUserFunction userFunctionFunction) -> UserFunction{..})
|
||||
|
||||
instance ToJSON (InvitableJunction UserLecturer) where
|
||||
toJSON = genericToJSON defaultOptions { constructorTagModifier = camelToPathPiece' 1 }
|
||||
toEncoding = genericToEncoding defaultOptions { constructorTagModifier = camelToPathPiece' 1 }
|
||||
instance FromJSON (InvitableJunction UserLecturer) where
|
||||
parseJSON = genericParseJSON defaultOptions { constructorTagModifier = camelToPathPiece' 1 }
|
||||
instance ToJSON (InvitableJunction UserFunction) where
|
||||
toJSON = genericToJSON defaultOptions { constructorTagModifier = camelToPathPiece' 1
|
||||
, fieldLabelModifier = camelToPathPiece' 1
|
||||
}
|
||||
toEncoding = genericToEncoding defaultOptions { constructorTagModifier = camelToPathPiece' 1
|
||||
, fieldLabelModifier = camelToPathPiece' 1
|
||||
}
|
||||
instance FromJSON (InvitableJunction UserFunction) where
|
||||
parseJSON = genericParseJSON defaultOptions { constructorTagModifier = camelToPathPiece' 1
|
||||
, fieldLabelModifier = camelToPathPiece' 1
|
||||
}
|
||||
|
||||
instance ToJSON (InvitationDBData UserLecturer) where
|
||||
toJSON = genericToJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
|
||||
toEncoding = genericToEncoding defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
|
||||
instance FromJSON (InvitationDBData UserLecturer) where
|
||||
parseJSON = genericParseJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
|
||||
instance ToJSON (InvitationDBData UserFunction) where
|
||||
toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
|
||||
toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
|
||||
instance FromJSON (InvitationDBData UserFunction) where
|
||||
parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
|
||||
|
||||
instance ToJSON (InvitationTokenData UserLecturer) where
|
||||
toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 3 }
|
||||
toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 3 }
|
||||
instance FromJSON (InvitationTokenData UserLecturer) where
|
||||
parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 3 }
|
||||
instance ToJSON (InvitationTokenData UserFunction) where
|
||||
toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
|
||||
toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
|
||||
instance FromJSON (InvitationTokenData UserFunction) where
|
||||
parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
|
||||
|
||||
lecturerInvitationConfig :: InvitationConfig UserLecturer
|
||||
lecturerInvitationConfig = InvitationConfig{..}
|
||||
functionInvitationConfig :: InvitationConfig UserFunction
|
||||
functionInvitationConfig = InvitationConfig{..}
|
||||
where
|
||||
invitationRoute _ _ = return AdminLecturerInviteR
|
||||
invitationResolveFor InvTokenDataUserLecturer{..} = return $ SchoolKey invTokenUserLecturerSchool
|
||||
invitationSubject (Entity _ School{..}) _ = return . SomeMessage $ MsgMailSubjectSchoolLecturerInvitation schoolName
|
||||
invitationHeading (Entity _ School{..}) _ = return . SomeMessage $ MsgMailSchoolLecturerInviteHeading schoolName
|
||||
invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgSchoolLecturerInviteExplanation}|]
|
||||
invitationTokenConfig _ _ = do
|
||||
invitationRoute _ _ = return AdminFunctionaryInviteR
|
||||
invitationResolveFor InvTokenDataUserFunction{..} = return $ SchoolKey invTokenUserFunctionSchool
|
||||
invitationSubject (Entity _ School{..}) (_, InvTokenDataUserFunction{..}) = do
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
return . SomeMessage . MsgMailSubjectSchoolFunctionInvitation schoolName $ mr invTokenUserFunctionFunction
|
||||
invitationHeading (Entity _ School{..}) (_, InvTokenDataUserFunction{..}) = do
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
return . SomeMessage . MsgMailSchoolFunctionInviteHeading schoolName $ mr invTokenUserFunctionFunction
|
||||
invitationExplanation _ (_, InvTokenDataUserFunction{..}) = do
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
return [ihamlet|_{SomeMessage $ MsgSchoolFunctionInviteExplanation (mr $ SomeMessage invTokenUserFunctionFunction)}|]
|
||||
invitationTokenConfig _ (InvDBDataUserFunction{..}, _) = do
|
||||
itAuthority <- liftHandlerT requireAuthId
|
||||
return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
|
||||
let itExpiresAt = Just $ Just invDBUserFunctionDeadline
|
||||
itAddAuth = Nothing
|
||||
itStartsAt = Nothing
|
||||
return InvitationTokenConfig{..}
|
||||
invitationRestriction _ _ = return Authorized
|
||||
invitationForm _ _ _ = pure $ (JunctionUserLecturer, ())
|
||||
invitationForm _ (_, InvTokenDataUserFunction{..}) _ = pure $ (JunctionUserFunction invTokenUserFunctionFunction, ())
|
||||
invitationInsertHook _ _ _ _ = id
|
||||
invitationSuccessMsg (Entity _ School{..}) _ = return . SomeMessage $ MsgSchoolLecturerInvitationAccepted schoolName
|
||||
invitationSuccessMsg (Entity _ School{..}) (Entity _ UserFunction{..}) = do
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
return . SomeMessage . MsgSchoolFunctionInvitationAccepted schoolName $ mr userFunctionFunction
|
||||
invitationUltDest (Entity ssh _) _ = do
|
||||
currentTerm <- E.select . E.from $ \term -> do
|
||||
E.where_ $ term E.^. TermActive
|
||||
@ -496,39 +501,50 @@ lecturerInvitationConfig = InvitationConfig{..}
|
||||
_other -> CourseListR
|
||||
|
||||
|
||||
getAdminNewLecturerInviteR, postAdminNewLecturerInviteR :: Handler Html
|
||||
getAdminNewLecturerInviteR = postAdminNewLecturerInviteR
|
||||
postAdminNewLecturerInviteR = do
|
||||
getAdminNewFunctionaryInviteR, postAdminNewFunctionaryInviteR :: Handler Html
|
||||
getAdminNewFunctionaryInviteR = postAdminNewFunctionaryInviteR
|
||||
postAdminNewFunctionaryInviteR = do
|
||||
uid <- requireAuthId
|
||||
userSchools <- runDB . E.select . E.from $ \userAdmin -> do
|
||||
E.where_ $ userAdmin E.^. UserAdminUser E.==. E.val uid
|
||||
return $ userAdmin E.^. UserAdminSchool
|
||||
E.where_ $ userAdmin E.^. UserFunctionUser E.==. E.val uid
|
||||
E.&&. userAdmin E.^. UserFunctionFunction E.==. E.val SchoolAdmin
|
||||
return $ userAdmin E.^. UserFunctionSchool
|
||||
|
||||
((invitesResult, invitesWgt), invitesEncoding) <- runFormPost . renderWForm FormStandard $ do
|
||||
school <- wreq (schoolFieldFor $ map E.unValue userSchools) (fslI MsgLecturerInviteSchool) Nothing
|
||||
users <- wreq (multiUserField False Nothing) (fslI MsgLecturerInviteField & setTooltip MsgMultiEmailFieldTip) Nothing
|
||||
return $ (,) <$> school <*> users
|
||||
now <- liftIO getCurrentTime
|
||||
let
|
||||
localNow = utcToLocalTime now
|
||||
beginToday = case localTimeToUTC (LocalTime (localDay localNow) midnight) of
|
||||
LTUUnique utc' _ -> utc'
|
||||
_other -> UTCTime (utctDay now) 0
|
||||
defDeadline = beginToday{ utctDay = 14 `addDays` utctDay beginToday }
|
||||
|
||||
formResultModal invitesResult UsersR $ \(schoolId, users) -> do
|
||||
function <- wreq (selectField optionsFinite) (fslI MsgFunctionaryInviteFunction) Nothing
|
||||
school <- wreq (schoolFieldFor $ map E.unValue userSchools) (fslI MsgFunctionaryInviteSchool) Nothing
|
||||
deadline <- wreq utcTimeField (fslI MsgExamRegistrationInviteDeadline) (Just defDeadline)
|
||||
users <- wreq (multiUserField False Nothing) (fslI MsgFunctionaryInviteField & setTooltip MsgMultiEmailFieldTip) Nothing
|
||||
return $ (,,,) <$> function <*> school <*> deadline <*> users
|
||||
|
||||
formResultModal invitesResult UsersR $ \(function, schoolId, deadline, users) -> do
|
||||
let (emails, uids) = partitionEithers $ Set.toList users
|
||||
lift . runDBJobs $ do
|
||||
forM_ uids $ \lecId ->
|
||||
void . insertUnique $ UserLecturer lecId schoolId
|
||||
void . insertUnique $ UserFunction lecId schoolId function
|
||||
|
||||
sinkInvitationsF lecturerInvitationConfig [ (mail, schoolId, (InvDBDataUserLecturer, InvTokenDataUserLecturer $ unSchoolKey schoolId)) | mail <- emails ]
|
||||
sinkInvitationsF functionInvitationConfig [ (mail, schoolId, (InvDBDataUserFunction deadline, InvTokenDataUserFunction (unSchoolKey schoolId) function)) | mail <- emails ]
|
||||
|
||||
unless (null emails) $
|
||||
tell . pure <=< messageI Success . MsgLecturersInvited $ length emails
|
||||
tell . pure <=< messageI Success . MsgFunctionariesInvited $ length emails
|
||||
unless (null uids) $
|
||||
tell . pure <=< messageI Success . MsgLecturersAdded $ length uids
|
||||
tell . pure <=< messageI Success . MsgFunctionariesAdded $ length uids
|
||||
|
||||
siteLayoutMsg MsgLecturerInviteHeading $ do
|
||||
setTitleI MsgLecturerInviteHeading
|
||||
siteLayoutMsg MsgFunctionaryInviteHeading $ do
|
||||
setTitleI MsgFunctionaryInviteHeading
|
||||
wrapForm invitesWgt def
|
||||
{ formEncoding = invitesEncoding
|
||||
, formAction = Just $ SomeRoute AdminNewLecturerInviteR
|
||||
, formAction = Just $ SomeRoute AdminNewFunctionaryInviteR
|
||||
}
|
||||
|
||||
getAdminLecturerInviteR, postAdminLecturerInviteR :: Handler Html
|
||||
getAdminLecturerInviteR = postAdminLecturerInviteR
|
||||
postAdminLecturerInviteR = invitationR lecturerInvitationConfig
|
||||
getAdminFunctionaryInviteR, postAdminFunctionaryInviteR :: Handler Html
|
||||
getAdminFunctionaryInviteR = postAdminFunctionaryInviteR
|
||||
postAdminFunctionaryInviteR = invitationR functionInvitationConfig
|
||||
|
||||
@ -4,8 +4,6 @@ module Handler.Utils
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
import Data.Map ((!))
|
||||
@ -15,10 +13,6 @@ import Data.CaseInsensitive (original)
|
||||
-- import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.Conduit.List as Conduit
|
||||
|
||||
import Language.Haskell.TH
|
||||
import Language.Haskell.TH.Syntax (qRunIO)
|
||||
-- import Language.Haskell.TH.Datatype
|
||||
|
||||
import Text.Hamlet (shamletFile)
|
||||
|
||||
import Handler.Utils.DateTime as Handler.Utils
|
||||
@ -32,12 +26,9 @@ import Handler.Utils.Rating as Handler.Utils hiding (extractRatings)
|
||||
import Handler.Utils.Sheet as Handler.Utils
|
||||
import Handler.Utils.Mail as Handler.Utils
|
||||
import Handler.Utils.ContentDisposition as Handler.Utils
|
||||
import Handler.Utils.I18n as Handler.Utils
|
||||
|
||||
import System.Directory (listDirectory)
|
||||
import System.FilePath.Posix (takeBaseName, takeFileName)
|
||||
|
||||
import qualified Data.List as List
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
import System.FilePath.Posix (takeFileName)
|
||||
|
||||
import Control.Monad.Logger
|
||||
|
||||
@ -218,36 +209,6 @@ warnTermDays tid timeNames = do
|
||||
forM_ outoflecture $ warnI MsgDayIsOutOfLecture
|
||||
forM_ outoftermdays $ warnI MsgDayIsOutOfTerm
|
||||
|
||||
-- | Add language dependent template files
|
||||
--
|
||||
-- For large files which are translated as a whole.
|
||||
--
|
||||
-- Argument musst be a directory under @/templates@,
|
||||
-- which contains a file for each language,
|
||||
-- eg. @imprint@ for choosing between
|
||||
-- @/templates/imprint/de.hamlet@, @/templates/imprint/de-at.hamlet@,
|
||||
-- and @/templates/imprint/en.hamlet@
|
||||
--
|
||||
-- Dependency detection cannot work properly (no `addDependentFile`-equivalent
|
||||
-- for directories)
|
||||
-- @$ stack clean@ is required so new translations show up
|
||||
i18nWidgetFile :: FilePath -> Q Exp
|
||||
i18nWidgetFile basename = do
|
||||
-- Construct list of available translations (@de@, @en@, ...) at compile time
|
||||
let i18nDirectory = "templates" </> "i18n" </> basename
|
||||
availableFiles <- qRunIO $ listDirectory i18nDirectory
|
||||
let availableTranslations = sortWith (NTop . flip List.elemIndex (NonEmpty.toList appLanguages)) . List.nub $ pack . takeBaseName <$> availableFiles
|
||||
availableTranslations' <- maybe (fail $ "‘" <> i18nDirectory <> "’ is empty") return $ NonEmpty.nonEmpty availableTranslations
|
||||
|
||||
-- Dispatch to correct language (depending on user settings via `selectLanguage`) at run time
|
||||
ws <- newName "ws" -- Name for dispatch function
|
||||
letE
|
||||
[ funD ws $ [ clause [litP $ stringL l] (normalB . widgetFile $ "i18n" </> basename </> l) []
|
||||
| l <- unpack <$> NonEmpty.toList availableTranslations' -- One function definition for every available language
|
||||
] ++ [ clause [wildP] (normalB [e| error "selectLanguage returned an invalid translation" |]) [] ] -- Fallback mostly there so compiler does not complain about non-exhaustive pattern match
|
||||
] [e|selectLanguage availableTranslations' >>= $(varE ws)|]
|
||||
|
||||
|
||||
|
||||
-- | return a value only if the current user ist authorized for a given route
|
||||
guardAuthorizedFor :: ( HandlerSite h ~ UniWorX, MonadHandler h, MonadLogger h
|
||||
@ -264,3 +225,11 @@ runAppLoggingT app@(appLogger -> (_, loggerTVar)) = flip runLoggingT logFunc
|
||||
f <- messageLoggerSource app <$> readTVarIO loggerTVar
|
||||
f loc src lvl str
|
||||
|
||||
studyFeaturesWidget :: StudyFeaturesId -> Widget
|
||||
studyFeaturesWidget featId = do
|
||||
(StudyFeatures{studyFeaturesSemester}, (degree, terms)) <- liftHandlerT . runDB . ($ featId) . runKleisli $ Kleisli getJust >>> Kleisli return &&& Kleisli (getJust . studyFeaturesDegree) &&& Kleisli (getJust . studyFeaturesField)
|
||||
[whamlet|
|
||||
$newline never
|
||||
_{StudyDegreeTerm degree terms}, _{MsgStudyFeatureAge} #{studyFeaturesSemester}
|
||||
|]
|
||||
|
||||
|
||||
@ -9,7 +9,6 @@ module Handler.Utils.Communication
|
||||
|
||||
import Import
|
||||
import Handler.Utils
|
||||
import Utils.Lens
|
||||
|
||||
import Jobs.Queue
|
||||
import Control.Monad.Trans.Reader (mapReaderT)
|
||||
|
||||
@ -5,8 +5,6 @@ module Handler.Utils.ContentDisposition
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
-- | Check whether the user's preference for files is inline-viewing or downloading
|
||||
downloadFiles :: (MonadHandler m, HandlerSite m ~ UniWorX) => m Bool
|
||||
downloadFiles = do
|
||||
|
||||
@ -16,8 +16,6 @@ module Handler.Utils.DateTime
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import Data.Time.Zones
|
||||
import qualified Data.Time.Zones as TZ
|
||||
|
||||
|
||||
@ -17,8 +17,6 @@ module Handler.Utils.Delete
|
||||
import Import
|
||||
import Handler.Utils.Form
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Set as Set
|
||||
|
||||
|
||||
@ -12,8 +12,6 @@ import qualified Database.Esqueleto.Utils as E
|
||||
import qualified Database.Esqueleto.Internal.Sql as E
|
||||
import Database.Esqueleto.Utils.TH
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
||||
@ -40,13 +40,9 @@ import Control.Monad.Error.Class (MonadError(..))
|
||||
|
||||
import Data.Either (partitionEithers)
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import Data.Aeson (eitherDecodeStrict')
|
||||
import Data.Aeson.Text (encodeToLazyText)
|
||||
|
||||
import Data.Proxy
|
||||
|
||||
import qualified Text.Email.Validate as Email
|
||||
|
||||
import Yesod.Core.Types (FileInfo(..))
|
||||
@ -852,7 +848,7 @@ localTimeField = Field
|
||||
where
|
||||
fieldTimeFormat :: String
|
||||
--fieldTimeFormat = "%e.%m.%y %k:%M"
|
||||
fieldTimeFormat = "%Y-%m-%dT%H:%M"
|
||||
fieldTimeFormat = "%Y-%m-%dT%H:%M:%S"
|
||||
|
||||
-- `defaultTimeLocale` is okay here, since `fieldTimeFormat` does not contain any
|
||||
readTime :: Text -> Either UniWorXMessage LocalTime
|
||||
|
||||
@ -7,7 +7,7 @@ module Handler.Utils.Form.MassInput
|
||||
, massInput
|
||||
, module Handler.Utils.Form.MassInput.Liveliness
|
||||
, massInputA, massInputW
|
||||
, massInputList
|
||||
, massInputList, massInputListA
|
||||
, massInputAccum, massInputAccumA, massInputAccumW
|
||||
, massInputAccumEdit, massInputAccumEditA, massInputAccumEditW
|
||||
, ListLength(..), ListPosition(..), miDeleteList
|
||||
@ -17,7 +17,6 @@ module Handler.Utils.Form.MassInput
|
||||
|
||||
import Import
|
||||
import Utils.Form
|
||||
import Utils.Lens
|
||||
import Handler.Utils.Form.MassInput.Liveliness
|
||||
import Handler.Utils.Form.MassInput.TH
|
||||
|
||||
@ -487,6 +486,22 @@ massInputList field fieldSettings miButtonAction miIdent miSettings miRequired m
|
||||
miRequired
|
||||
(Map.fromList . zip [0..] . map ((), ) <$> miPrevResult)
|
||||
|
||||
massInputListA :: forall handler cellResult ident.
|
||||
( MonadHandler handler, HandlerSite handler ~ UniWorX
|
||||
, MonadLogger handler
|
||||
, PathPiece ident
|
||||
)
|
||||
=> Field handler cellResult
|
||||
-> (ListPosition -> FieldSettings UniWorX)
|
||||
-> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX))
|
||||
-> ident
|
||||
-> FieldSettings UniWorX
|
||||
-> Bool
|
||||
-> Maybe [cellResult]
|
||||
-> AForm handler [cellResult]
|
||||
massInputListA field fieldSettings miButtonAction miIdent miSettings miRequired miPrevResult = formToAForm . fmap (over _2 pure) $ massInputList field fieldSettings miButtonAction miIdent miSettings miRequired miPrevResult mempty
|
||||
|
||||
|
||||
-- | Wrapper around `massInput` for the common case, that we just want a list of data with no option to modify it except deletion and addition
|
||||
massInputAccum :: forall handler cellData ident.
|
||||
( MonadHandler handler, HandlerSite handler ~ UniWorX
|
||||
|
||||
@ -10,8 +10,6 @@ import qualified Data.Set as Set
|
||||
import Data.Map ((!))
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
|
||||
data OccurrenceScheduleKind = ScheduleKindWeekly
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
|
||||
|
||||
43
src/Handler/Utils/I18n.hs
Normal file
43
src/Handler/Utils/I18n.hs
Normal file
@ -0,0 +1,43 @@
|
||||
module Handler.Utils.I18n
|
||||
where
|
||||
|
||||
import Import
|
||||
|
||||
import Language.Haskell.TH
|
||||
import Language.Haskell.TH.Syntax (qRunIO)
|
||||
|
||||
import qualified Data.List as List
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
|
||||
import System.Directory (listDirectory)
|
||||
import System.FilePath.Posix (takeBaseName)
|
||||
|
||||
|
||||
-- | Add language dependent template files
|
||||
--
|
||||
-- For large files which are translated as a whole.
|
||||
--
|
||||
-- Argument musst be a directory under @/templates@,
|
||||
-- which contains a file for each language,
|
||||
-- eg. @imprint@ for choosing between
|
||||
-- @/templates/imprint/de.hamlet@, @/templates/imprint/de-at.hamlet@,
|
||||
-- and @/templates/imprint/en.hamlet@
|
||||
--
|
||||
-- Dependency detection cannot work properly (no `addDependentFile`-equivalent
|
||||
-- for directories)
|
||||
-- @$ stack clean@ is required so new translations show up
|
||||
i18nWidgetFile :: FilePath -> Q Exp
|
||||
i18nWidgetFile basename = do
|
||||
-- Construct list of available translations (@de@, @en@, ...) at compile time
|
||||
let i18nDirectory = "templates" </> "i18n" </> basename
|
||||
availableFiles <- qRunIO $ listDirectory i18nDirectory
|
||||
let availableTranslations = sortWith (NTop . flip List.elemIndex (NonEmpty.toList appLanguages)) . List.nub $ pack . takeBaseName <$> availableFiles
|
||||
availableTranslations' <- maybe (fail $ "‘" <> i18nDirectory <> "’ is empty") return $ NonEmpty.nonEmpty availableTranslations
|
||||
|
||||
-- Dispatch to correct language (depending on user settings via `selectLanguage`) at run time
|
||||
ws <- newName "ws" -- Name for dispatch function
|
||||
letE
|
||||
[ funD ws $ [ clause [litP $ stringL l] (normalB . widgetFile $ "i18n" </> basename </> l) []
|
||||
| l <- unpack <$> NonEmpty.toList availableTranslations' -- One function definition for every available language
|
||||
] ++ [ clause [wildP] (normalB [e| error "selectLanguage returned an invalid translation" |]) [] ] -- Fallback mostly there so compiler does not complain about non-exhaustive pattern match
|
||||
] [e|selectLanguage availableTranslations' >>= $(varE ws)|]
|
||||
@ -16,7 +16,6 @@ module Handler.Utils.Invitations
|
||||
) where
|
||||
|
||||
import Import
|
||||
import Utils.Lens
|
||||
import Utils.Form
|
||||
import Jobs.Queue
|
||||
|
||||
@ -123,7 +122,7 @@ data InvitationConfig junction = forall formCtx. InvitationConfig
|
||||
-- ^ Subject of the e-mail which sends the token to the user
|
||||
, invitationHeading :: Entity (InvitationFor junction) -> InvitationData junction -> DB (SomeMessage UniWorX)
|
||||
-- ^ Heading of the page which allows the invitee to accept/decline the invitation (`invitationR`
|
||||
, invitationExplanation :: Entity (InvitationFor junction) -> InvitationData junction -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)
|
||||
, invitationExplanation :: Entity (InvitationFor junction) -> InvitationData junction -> DB (HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX))
|
||||
-- ^ Explanation of what kind of invitation this is (used both in the e-mail and in `invitationR`)
|
||||
, invitationTokenConfig :: Entity (InvitationFor junction) -> InvitationData junction -> DB InvitationTokenConfig
|
||||
-- ^ Parameters for creating the invitation token (`InvitationTokenData` is handled transparently)
|
||||
@ -176,7 +175,7 @@ sinkInvitations :: forall junction.
|
||||
-- updated, instead.
|
||||
--
|
||||
-- For new junctions an invitation is sent by e-mail.
|
||||
sinkInvitations InvitationConfig{..} = determineExists .| C.foldMap pure >>= lift . sinkInvitations'
|
||||
sinkInvitations InvitationConfig{..} = determineExists .| sinkInvitations'
|
||||
where
|
||||
determineExists :: Conduit (Invitation' junction)
|
||||
(YesodJobDB UniWorX)
|
||||
@ -202,13 +201,9 @@ sinkInvitations InvitationConfig{..} = determineExists .| C.foldMap pure >>= lif
|
||||
JSON.Success dbData -> return dbData
|
||||
JSON.Error str -> fail $ "Could not decode invitationData: " <> str
|
||||
|
||||
sinkInvitations' :: [Invitation' junction]
|
||||
-> YesodJobDB UniWorX ()
|
||||
sinkInvitations' new = do
|
||||
when (is _Nothing (ephemeralInvitation @junction)) $ do
|
||||
insertMany_ $ map (\(email, fid, dat) -> Invitation email (invRef @junction fid) (toJSON $ dat ^. _invitationDBData)) new
|
||||
-- forM_ existing $ \(iid, oldDat) -> update iid [ InvitationData =. toJSON (dat ^. _invitationDBData) ]
|
||||
forM_ new $ \(jInvitee, fid, dat) -> do
|
||||
sinkInvitations' :: Sink (Invitation' junction) (YesodJobDB UniWorX) ()
|
||||
sinkInvitations' = do
|
||||
C.mapM_ $ \(jInvitee, fid, dat) -> do
|
||||
app <- getYesod
|
||||
let mr = renderMessage app $ NonEmpty.toList appLanguages
|
||||
ur <- getUrlRenderParams
|
||||
@ -223,7 +218,14 @@ sinkInvitations InvitationConfig{..} = determineExists .| C.foldMap pure >>= lif
|
||||
jwt <- encodeToken token
|
||||
jInvitationUrl <- toTextUrl (route, [(toPathPiece GetBearer, toPathPiece jwt)])
|
||||
jInvitationSubject <- fmap mr . mapReaderT liftHandlerT $ invitationSubject fEnt dat
|
||||
let jInvitationExplanation = invitationExplanation fEnt dat (toHtml . mr) ur
|
||||
jInvitationExplanation <- (\ihtml -> ihtml (toHtml . mr) ur) <$> mapReaderT liftHandlerT (invitationExplanation fEnt dat)
|
||||
|
||||
when (is _Nothing (ephemeralInvitation @junction)) $ insert_ $ Invitation
|
||||
{ invitationEmail = jInvitee
|
||||
, invitationFor = invRef @junction fid
|
||||
, invitationData = toJSON $ dat ^. _invitationDBData
|
||||
, invitationExpiresAt = tokenExpiresAt token
|
||||
}
|
||||
|
||||
queueDBJob JobInvitation{..}
|
||||
|
||||
@ -246,9 +248,9 @@ sourceInvitations :: forall junction.
|
||||
-> Source (YesodDB UniWorX) (UserEmail, InvitationDBData junction)
|
||||
sourceInvitations forKey = selectSource [InvitationFor ==. invRef @junction forKey] [] .| C.mapM decode
|
||||
where
|
||||
decode (Entity _ (Invitation email _ invitationData))
|
||||
decode (Entity _ (Invitation{invitationEmail, invitationData}))
|
||||
= case fromJSON invitationData of
|
||||
JSON.Success dbData -> return (email, dbData)
|
||||
JSON.Success dbData -> return (invitationEmail, dbData)
|
||||
JSON.Error str -> fail $ "Could not decode invitationData: " <> str
|
||||
|
||||
sourceInvitationsList :: forall junction.
|
||||
@ -309,7 +311,7 @@ invitationR' InvitationConfig{..} = liftHandlerT $ do
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
ur <- getUrlRenderParams
|
||||
heading <- invitationHeading fEnt iData
|
||||
let explanation = invitationExplanation fEnt iData (toHtml . mr) ur
|
||||
explanation <- (\ihtml -> ihtml (toHtml . mr) ur) <$> invitationExplanation fEnt iData
|
||||
|
||||
fmap (, (dataWidget, dataEnctype), heading, explanation) . formResultMaybe dataRes $ \case
|
||||
Nothing -> do
|
||||
|
||||
@ -7,8 +7,6 @@ module Handler.Utils.Mail
|
||||
|
||||
import Import
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
|
||||
@ -39,8 +39,6 @@ import qualified Database.Esqueleto as E
|
||||
|
||||
import qualified Data.Conduit.List as Conduit
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
|
||||
instance HasResolution prec => Pretty (Fixed prec) where
|
||||
pretty = pretty . show
|
||||
@ -159,7 +157,7 @@ parseRating File{ fileContent = Just input, .. } = do
|
||||
ratingStr = Text.unpack $ Text.strip ratingLine
|
||||
ratingPoints <- case () of
|
||||
_ | null ratingStr -> return Nothing
|
||||
| otherwise -> either (throw . RatingInvalid) return $ Just <$> readEither ratingStr
|
||||
| otherwise -> either (throw . RatingInvalid . pack) return $ Just <$> readEither ratingStr
|
||||
return Rating'{ ratingTime = Just fileModified, .. }
|
||||
parseRating _ = throwM RatingFileIsDirectory
|
||||
|
||||
|
||||
32
src/Handler/Utils/SchoolLdap.hs
Normal file
32
src/Handler/Utils/SchoolLdap.hs
Normal file
@ -0,0 +1,32 @@
|
||||
module Handler.Utils.SchoolLdap
|
||||
( parseLdapSchools
|
||||
) where
|
||||
|
||||
import Import.NoFoundation hiding (try, (<|>), choice)
|
||||
|
||||
import Text.Parsec
|
||||
import Text.Parsec.Text
|
||||
|
||||
import Data.CaseInsensitive (CI)
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import qualified Data.Set as Set
|
||||
|
||||
|
||||
parseLdapSchools :: Text -> Either ParseError (Set (CI Text))
|
||||
parseLdapSchools = parse pLdapSchools ""
|
||||
|
||||
pLdapSchools :: Parser (Set (CI Text))
|
||||
pLdapSchools = Set.fromList . map CI.mk <$> pSegment `sepBy` char ','
|
||||
|
||||
pSegment :: Parser Text
|
||||
pSegment = do
|
||||
let
|
||||
fragStart = flip label "fragment start" $ do
|
||||
void . choice . map (try . string) $ sortOn Down
|
||||
[ "l", "st", "o", "ou", "c", "street", "dc" ]
|
||||
void $ char '='
|
||||
|
||||
fragStart
|
||||
pack <$> manyTill anyChar (try (lookAhead $ char ',' >> fragStart) <|> eof)
|
||||
|
||||
@ -5,7 +5,6 @@ module Handler.Utils.SheetType
|
||||
|
||||
import Import
|
||||
import Data.Monoid (Sum(..))
|
||||
import Utils.Lens
|
||||
|
||||
addBonusToPoints :: SheetTypeSummary -> SheetTypeSummary
|
||||
addBonusToPoints sts =
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user