Merge remote-tracking branch 'origin/feat/pagination' into feat/exercises

This commit is contained in:
SJost 2018-04-10 10:40:10 +02:00
commit 4a7d35144a
17 changed files with 1041 additions and 195 deletions

View File

@ -452,12 +452,13 @@ defaultMenuLayout menu widget = do
pc <- widgetToPageContent $ do
addStylesheetRemote "https://fonts.googleapis.com/css?family=Source+Sans+Pro:300,400,600,800,900"
addScript $ StaticR js_featureChecker_js
addScript $ StaticR js_fetchPolyfill_js
addScript $ StaticR js_urlPolyfill_js
addStylesheet $ StaticR css_fonts_css
addStylesheet $ StaticR css_icons_css
$(widgetFile "default-layout")
$(widgetFile "standalone/modal")
$(widgetFile "standalone/showHide")
$(widgetFile "standalone/sortable")
$(widgetFile "standalone/inputs")
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")

View File

@ -1,11 +1,13 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude
, OverloadedStrings
, OverloadedLists
, RecordWildCards
, TemplateHaskell
, QuasiQuotes
, MultiParamTypeClasses
, TypeFamilies
, FlexibleContexts
#-}
module Handler.Term where
@ -29,7 +31,7 @@ getTermShowR = do
-- return term
--
let
termData = E.from $ \term -> do
termData term = do
-- E.orderBy [E.desc $ term E.^. TermStart ]
let courseCount :: E.SqlExpr (E.Value Int)
courseCount = E.sub_select . E.from $ \course -> do
@ -37,10 +39,10 @@ getTermShowR = do
return E.countRows
return (term, courseCount)
selectRep $ do
provideRep $ toJSON . map fst <$> runDB (E.select termData)
provideRep $ toJSON . map fst <$> runDB (E.select $ E.from termData)
provideRep $ do
let colonnadeTerms = mconcat
[ headed "Kürzel" $ \(Entity tid Term{..},_) -> cell $ do
[ sortable Nothing "Kürzel" $ \(Entity tid Term{..},_) -> cell $ do
-- Scrap this if to slow, create term edit page instead
adminLink <- handlerToWidget $ isAuthorized (TermEditExistR tid) False
[whamlet|
@ -50,28 +52,40 @@ getTermShowR = do
$else
#{termToText termName}
|]
, headed "Beginn Vorlesungen" $ \(Entity _ Term{..},_) ->
, sortable (Just "lecture-start") "Beginn Vorlesungen" $ \(Entity _ Term{..},_) ->
stringCell $ formatTimeGerWD termLectureStart
, headed "Ende Vorlesungen" $ \(Entity _ Term{..},_) ->
, sortable (Just "lecture-end") "Ende Vorlesungen" $ \(Entity _ Term{..},_) ->
stringCell $ formatTimeGerWD termLectureEnd
, headed "Aktiv" $ \(Entity _ Term{..},_) ->
, sortable Nothing "Aktiv" $ \(Entity _ Term{..},_) ->
textCell $ bool "" tickmark termActive
, headed "Kursliste" $ \(Entity tid Term{..}, E.Value numCourses) ->
, sortable Nothing "Kursliste" $ \(Entity tid Term{..}, E.Value numCourses) ->
cell [whamlet|
<a href=@{CourseListTermR tid}>
#{show numCourses} Kurse
|]
, headed "Semesteranfang" $ \(Entity _ Term{..},_) ->
, sortable (Just "start") "Semesteranfang" $ \(Entity _ Term{..},_) ->
stringCell $ formatTimeGerWD termStart
, headed "Semesterende" $ \(Entity _ Term{..},_) ->
, sortable (Just "end") "Semesterende" $ \(Entity _ Term{..},_) ->
stringCell $ formatTimeGerWD termEnd
, headed "Feiertage im Semester" $ \(Entity _ Term{..},_) ->
, sortable Nothing "Feiertage im Semester" $ \(Entity _ Term{..},_) ->
stringCell $ (intercalate ", ") $ map formatTimeGerWD termHolidays
]
table <- dbTable def $ DBTable
{ dbtSQLQuery = termData
, dbtColonnade = colonnadeTerms
, dbtSorting = mempty
, dbtSorting = [ ( "start"
, SortColumn $ \term -> term E.^. TermStart
)
, ( "end"
, SortColumn $ \term -> term E.^. TermEnd
)
, ( "lecture-start"
, SortColumn $ \term -> term E.^. TermLectureStart
)
, ( "lecture-end"
, SortColumn $ \term -> term E.^. TermLectureEnd
)
]
, dbtAttrs = tableDefault
, dbtIdent = "terms" :: Text
}

View File

@ -6,6 +6,7 @@
, QuasiQuotes
, LambdaCase
, ViewPatterns
, FlexibleContexts
#-}
module Handler.Utils.Table.Pagination
@ -13,14 +14,24 @@ module Handler.Utils.Table.Pagination
, DBTable(..)
, PaginationSettings(..)
, PSValidator(..)
, Sortable(..), sortable
, dbTable
) where
import Handler.Utils.Table.Pagination.Types
import Import
import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Internal.Sql as E (SqlSelect)
import qualified Database.Esqueleto.Internal.Language as E (From)
import Text.Blaze (Attribute)
import qualified Text.Blaze.Html5.Attributes as Html5
import qualified Text.Blaze.Html5 as Html5
import Yesod.Core.Types (Body(..),GWData(..),WidgetT(..))
import qualified Data.Binary.Builder as Builder
import qualified Network.Wai as Wai
import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
@ -30,6 +41,7 @@ import Control.Monad.RWS hiding ((<>), Foldable(..), mapM_)
import Data.Map (Map, (!))
import Colonnade hiding (bool, fromMaybe)
import Colonnade.Encode
import Yesod.Colonnade
import Text.Hamlet (hamletFile)
@ -37,7 +49,7 @@ import Text.Hamlet (hamletFile)
import Data.Ratio ((%))
data SortColumn = forall a. PersistField a => SortColumn { getSortColumn :: E.SqlExpr (E.Value a) }
data SortColumn t = forall a. PersistField a => SortColumn { getSortColumn :: t -> E.SqlExpr (E.Value a) }
data SortDirection = SortAsc | SortDesc
deriving (Eq, Ord, Enum, Show, Read)
@ -49,18 +61,19 @@ instance PathPiece SortDirection where
| t == "desc" = Just SortDesc
| otherwise = Nothing
sqlSortDirection :: (SortColumn, SortDirection) -> E.SqlExpr E.OrderBy
sqlSortDirection (SortColumn e, SortAsc ) = E.asc e
sqlSortDirection (SortColumn e, SortDesc) = E.desc e
sqlSortDirection :: t -> (SortColumn t, SortDirection) -> E.SqlExpr E.OrderBy
sqlSortDirection t (SortColumn e, SortAsc ) = E.asc $ e t
sqlSortDirection t (SortColumn e, SortDesc) = E.desc $ e t
data DBTable = forall a r h i.
( Headedness h
data DBTable = forall a r h i t.
( ToSortable h
, E.SqlSelect a r
, PathPiece i
, E.From E.SqlQuery E.SqlExpr E.SqlBackend t
) => DBTable
{ dbtSQLQuery :: E.SqlQuery a
{ dbtSQLQuery :: t -> E.SqlQuery a
, dbtColonnade :: Colonnade h r (Cell UniWorX)
, dbtSorting :: Map Text SortColumn
, dbtSorting :: Map Text (SortColumn t)
, dbtAttrs :: Attribute
, dbtIdent :: i
}
@ -91,6 +104,7 @@ instance Default PSValidator where
modify $ \ps -> ps { psLimit = psLimit def }
tell . pure $ SomeMessage MsgPSLimitNonPositive
dbTable :: PSValidator -> DBTable -> Handler Widget
dbTable PSValidator{..} DBTable{ dbtIdent = (toPathPiece -> dbtIdent), .. } = do
let
@ -109,7 +123,7 @@ dbTable PSValidator{..} DBTable{ dbtIdent = (toPathPiece -> dbtIdent), .. } = do
| otherwise = dbtAttrs
psResult <- runInputGetResult $ PaginationSettings
<$> ireq (multiSelectField $ return sortingOptions) (wIdent "sorting")
<$> (fromMaybe [] <$> iopt (multiSelectField $ return sortingOptions) (wIdent "sorting"))
<*> (fromMaybe (psLimit defPS) <$> iopt intField (wIdent "pagesize"))
<*> (fromMaybe (psPage defPS) <$> iopt intField (wIdent "page"))
<*> ireq checkBoxField (wIdent "table-only")
@ -125,21 +139,50 @@ dbTable PSValidator{..} DBTable{ dbtIdent = (toPathPiece -> dbtIdent), .. } = do
FormFailure errs -> first (map SomeMessage errs <>) $ runPSValidator Nothing
FormMissing -> runPSValidator Nothing
psSorting' = map (first (dbtSorting !)) psSorting
sqlQuery' = dbtSQLQuery
<* E.orderBy (map sqlSortDirection psSorting')
sqlQuery' = E.from $ \t -> dbtSQLQuery t
<* E.orderBy (map (sqlSortDirection t) psSorting')
<* E.limit psLimit
<* E.offset (psPage * psLimit)
mapM_ (addMessageI "warning") errs
(rows, [E.Value rowCount]) <- runDB $ (,) <$> E.select sqlQuery' <*> E.select (E.countRows <$ dbtSQLQuery :: E.SqlQuery (E.SqlExpr (E.Value Int64)))
(rows, [E.Value rowCount]) <- runDB $ (,) <$> E.select sqlQuery' <*> E.select (E.countRows <$ E.from dbtSQLQuery :: E.SqlQuery (E.SqlExpr (E.Value Int64)))
bool return (sendResponse <=< tblLayout) psShortcircuit $ do
let table = encodeCellTable dbtAttrs' dbtColonnade rows
getParams <- handlerToWidget $ queryToQueryText . Wai.queryString . reqWaiRequest <$> getRequest
let table = $(widgetFile "table/colonnade")
pageCount = max 1 . ceiling $ rowCount % psLimit
$(widgetFile "table-layout")
tblLink f = decodeUtf8 . Builder.toLazyByteString . renderQueryText True $ f getParams
withSortLinks Sortable{ sortableContent = Cell{..}, .. } = Cell
{ cellContents = $(widgetFile "table/sortable-header")
, ..
}
$(widgetFile "table/layout")
where
tblLayout :: Widget -> Handler Html
tblLayout tbl' = do
tbl <- widgetToPageContent tbl'
withUrlRenderer $(hamletFile "templates/table-layout-wrapper.hamlet")
withUrlRenderer $(hamletFile "templates/table/layout-wrapper.hamlet")
setParam :: Text -> Maybe Text -> QueryText -> QueryText
setParam key v qt = (key, v) : [ i | i@(key', _) <- qt, key' /= key ]
widgetFromCell ::
(Attribute -> WidgetT site IO () -> WidgetT site IO ())
-> Cell site
-> WidgetT site IO ()
widgetFromCell f (Cell attrs contents) =
f attrs contents
td,th ::
Attribute -> WidgetT site IO () -> WidgetT site IO ()
td = liftParent Html5.td
th = liftParent Html5.th
liftParent :: (Html -> Html) -> Attribute -> WidgetT site IO a -> WidgetT site IO a
liftParent el attrs (WidgetT f) = WidgetT $ \hdata -> do
(a,gwd) <- f hdata
let Body bodyFunc = gwdBody gwd
newBodyFunc render =
el Html5.! attrs $ (bodyFunc render)
return (a,gwd { gwdBody = Body newBodyFunc })

View File

@ -0,0 +1,40 @@
{-# LANGUAGE NoImplicitPrelude
, ExistentialQuantification
, RankNTypes
, RecordWildCards
#-}
module Handler.Utils.Table.Pagination.Types where
import Import hiding (singleton)
import Colonnade
import Colonnade.Encode
data Sortable a = Sortable
{ sortableKey :: (Maybe Text)
, sortableContent :: a
}
sortable :: Maybe Text -> c -> (a -> c) -> Colonnade Sortable a c
sortable k h = singleton (Sortable k h)
instance Headedness Sortable where
headednessPure = Sortable Nothing
headednessExtract = Just $ \(Sortable _ x) -> x
headednessExtractForall = Just $ ExtractForall (\(Sortable _ x) -> x)
newtype SortableP s = SortableP { toSortable :: forall a. s a -> Sortable a}
class Headedness s => ToSortable s where
pSortable :: Maybe (SortableP s)
instance ToSortable Sortable where
pSortable = Just $ SortableP id
instance ToSortable Headed where
pSortable = Just $ SortableP (\(Headed x) -> Sortable Nothing x)
instance ToSortable Headless where
pSortable = Nothing

View File

@ -1,7 +1,4 @@
window.addEventListener('touchstart', function onFirstTouch() {
// we could use a class
document.body.classList.add('touch-supported');
// we only need to know once that a human touched the screen, so we can stop listening now
window.removeEventListener('touchstart', onFirstTouch, false);
}, false);

466
static/js/fetchPolyfill.js Normal file
View File

@ -0,0 +1,466 @@
(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);

348
static/js/urlPolyfill.js Normal file
View File

@ -0,0 +1,348 @@
(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))
);

View File

@ -26,43 +26,6 @@
<li .list-group-item>
<a href=@{SubmissionListR}>Dateien hochladen und abrufen
<hr>
<div .container>
<h2 .js-show-hide__toggle data-collapsed=true>Tabellen
<table .js-sortable>
<thead>
<tr>
<th .sorted-asc>ID
<th>TH1
<th>TH2
<th>TH3
<tbody>
<tr>
<td>0
<td>NT2
<td>CON2
<td>3
<tr>
<td>1
<td>5
<td>ONT2
<td>13
<tr>
<td>2
<td>CONT1
<td>NT2
<td>43
<tr>
<td>3
<td>43
<td>T2C2
<td>35
<tr>
<td>4
<td>73
<td>CA62
<td>7
<hr>
<div .container>
<h2>Funktionen zum Testen

View File

@ -1 +0,0 @@
<!-- only here to be able to include sortable using `toWidget` -->

View File

@ -1,107 +0,0 @@
/**
* delcare a table as sortable by adding class 'js-sortable'
*/
(function() {
'use strict';
window.utils = window.utils || {};
window.utils.sortable = function(table) {
var ASC = 1;
var DESC = -1;
var trs, ths, sortBy, sortDir, trContents;
function setup() {
trs = table.querySelectorAll('tr');
ths = table.querySelectorAll('th');
sortBy = 0;
sortDir = ASC;
trContents = [];
Array.from(trs).forEach(function(tr, rowIndex) {
if (rowIndex === 0) {
// register table headers as sort-listener
Array.from(tr.querySelectorAll('th')).forEach(function(th, thIndex) {
th.addEventListener('click', function(el) {
sortTableBy(thIndex);
});
});
} else {
// register table rows
trContents.push(Array.from(tr.querySelectorAll('td')).map(function(td) {
return td.innerHTML;
}));
}
});
}
setup();
function updateThs(thIndex, sortOrder) {
Array.from(ths).forEach(function (th) {
th.classList.remove('sorted-asc', 'sorted-desc');
});
var suffix = sortOrder > 0 ? 'asc' : 'desc';
ths[thIndex].classList.add('sorted-' + suffix);
}
function sortTableBy(thIndex) {
var sortKey = thIndex;
var sortOrder = ASC;
if (sortBy === sortKey) {
sortOrder = sortDir === ASC ? DESC : ASC;
}
trContents.sort(dynamicSortByType(sortKey, sortOrder));
trContents.sort(dynamicSortByKey(sortKey, sortOrder));
sortBy = thIndex;
sortDir = sortOrder;
updateThs(thIndex, sortOrder);
Array.from(trs).forEach(function(tr, trIndex) {
if (trIndex > 0) {
Array.from(tr.querySelectorAll('td')).forEach(function (td, tdIndex) {
td.innerHTML = trContents[trIndex - 1][tdIndex];
});
}
});
}
function dynamicSortByKey(key, order) {
return function (a,b) {
var aVal = parseInt(a[key]);
var bVal = parseInt(b[key]);
if ((isNaN(aVal) && !isNaN(bVal)) || (!isNaN(aVal) && isNaN(bVal))) {
return 1;
}
aVal = isNaN(aVal) ? a[key] : aVal;
bVal = isNaN(bVal) ? b[key] : bVal;
var result = (aVal < bVal) ? -1 : (aVal > bVal) ? 1 : 0;
return result * order;
}
}
function dynamicSortByType(key, order) {
return function (a,b) {
var aVal = parseInt(a[key]);
var bVal = parseInt(b[key]);
aVal = isNaN(aVal) ? a[key] : aVal;
bVal = isNaN(bVal) ? b[key] : bVal;
var res = (aVal < bVal ? -1 : aVal > bVal ? 1 : 0);
if (isNaN(aVal) && !isNaN(bVal)) {
res = -1;
}
if (!isNaN(aVal) && isNaN(bVal)) {
res = 1;
}
return res * order;
}
}
};
})();
document.addEventListener('DOMContentLoaded', function() {
Array.from(document.querySelectorAll('.js-sortable')).forEach(function(table) {
utils.sortable(table);
});
});

View File

@ -1,4 +0,0 @@
<div .table>
^{table}
<p style="text-align:center">
_{MsgPage (succ psPage) pageCount}

View File

@ -0,0 +1,12 @@
<table id="#{dbtIdent}">
$maybe sortableP <- pSortable
$with toSortable <- toSortable sortableP
<thead>
$forall OneColonnade{..} <- getColonnade dbtColonnade
^{widgetFromCell th $ withSortLinks $ toSortable oneColonnadeHead}
$nothing
<tbody>
$forall row <- rows
<tr>
$forall OneColonnade{..} <- getColonnade dbtColonnade
^{widgetFromCell td $ oneColonnadeEncode row}

View File

@ -0,0 +1,61 @@
(function collonadeClosure() {
'use strict';
document.addEventListener('DOMContentLoaded', function DOMContentLoaded() {
var ASC = 'asc';
var DESC = 'desc';
// TODO: Make use of interpolated dbtIdent
var table = document.querySelector('table');
var ths = Array.from(table.querySelectorAll('th'));
// attach click handler to each table-header
ths.map(function(th) {
var link = th.querySelector('a');
if (link) {
link.addEventListener('click', clickHandler);
}
});
// handles click on table header
function clickHandler(event) {
event.preventDefault();
var url = new URL(window.location.origin + window.location.pathname + this.getAttribute('href'));
var order = this.parentNode.dataset.order || ASC;
// TODO: not working here... getting whole page as response...
url.searchParams.set('table-only', 'true');
updateTableFrom(url);
markSorted(this.parentNode, order);
}
function markSorted(th, order) {
ths.forEach(function(th) {
th.classList.remove('sorted-asc', 'sorted-desc');
});
th.classList.add('sorted-' + order);
th.dataset.order = order;
}
// fetches new sorted table from url with params and replaces contents of current table
function updateTableFrom(url) {
fetch(url, {
headers: {
'Accept': 'text/html'
}
}).then(function(response) {
var contentType = response.headers.get("content-type");
if (!response.ok) {
throw ('Looks like there was a problem fetching ' + url.toString() + '. Status Code: ' + response.status);
}
return response.text();
}).then(function(data) {
// replace contents of table body
table.querySelector('tbody').innerHTML = data;
}).catch(function(err) {
console.error(err);
});
}
});
})();

View File

@ -1,16 +1,16 @@
table.js-sortable th {
table th {
cursor: pointer;
position: relative;
padding-right: 20px;
}
table.js-sortable th.sorted-asc,
table.js-sortable th.sorted-desc {
color: var(--darkbase);
table th.sorted-asc,
table th.sorted-desc {
color: var(--lightbase);
}
table.js-sortable th.sorted-asc::after,
table.js-sortable th.sorted-desc::after {
table th.sorted-asc::after,
table th.sorted-desc::after {
content: '';
position: absolute;
right: 0;
@ -22,10 +22,10 @@ table.js-sortable th.sorted-desc::after {
border-right: 8px solid transparent;
}
table.js-sortable th.sorted-asc::after {
table th.sorted-asc::after {
border-top: 8px solid var(--lightbase);
}
table.js-sortable th.sorted-desc::after {
table th.sorted-desc::after {
border-bottom: 8px solid var(--lightbase);
}

View File

@ -0,0 +1,6 @@
<div .table>
^{table}
$if pageCount > 1
<p style="text-align:center">
$# TODO: foreach (reachable pages) print link to that page
_{MsgPage (succ psPage) pageCount}

View File

@ -0,0 +1,7 @@
^{cellContents}
$maybe flag <- sortableKey
<br>
<a href=#{tblLink $ setParam (wIdent "sorting") (Just $ flag <> "-asc")}>asc
/
<a href=#{tblLink $ setParam (wIdent "sorting") (Just $ flag <> "-desc")}>desc
$nothing