cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add plain text representation for the page for a single job

Browse source 
Signed-off-by: Christopher Baines <mail@cbaines.net>
This commit is contained in:
Danjela Lura 2020-04-20 11:13:13 +02:00 • committed by Christopher Baines
parent 60cb07f469
commit c61a8afd36
3 changed files with 26 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

25
guix-data-service/web/jobs/controller.scm
View file

@ -131,13 +131,20 @@
(select-unprocessed-jobs-and-events conn)))) (select-unprocessed-jobs-and-events conn))))
(define (render-job mime-types conn job-id query-parameters) (define (render-job mime-types conn job-id query-parameters)
(render-html (let ((log-text (log-for-job conn job-id
#:sxml (view-job #:character-limit
job-id (assq-ref query-parameters 'characters)
query-parameters #:start-character
(log-for-job conn job-id (assq-ref query-parameters 'start_character))))
#:character-limit (case (most-appropriate-mime-type
(assq-ref query-parameters 'characters) '(text/plain text/html)
#:start-character mime-types)
(assq-ref query-parameters 'start_character))))) ((text/plain)
(render-text log-text))
(else
(render-html
#:sxml (view-job
job-id
query-parameters
log-text))))))

9
guix-data-service/web/jobs/html.scm
View file

@ -358,7 +358,14 @@
(div (div
(@ (class "row")) (@ (class "row"))
(div (div
(@ (class "col-sm-12")) (@ (class "col-md-6"))
(a (@ (class "btn btn-default btn-lg pull-left")
(style "margin-bottom: 20px;")
(href ,(string-append
"/job/" job-id ".txt")))
"View plain text"))
(div
(@ (class "col-md-6"))
(a (@ (class "btn btn-default btn-lg pull-right") (a (@ (class "btn btn-default btn-lg pull-right")
(style "margin-bottom: 20px;") (style "margin-bottom: 20px;")
(href "#bottom")) (href "#bottom"))

3
guix-data-service/web/util.scm
View file

@ -44,7 +44,8 @@
(define (request->path-components-and-mime-type request) (define (request->path-components-and-mime-type request)
(define extensions-to-mime-types (define extensions-to-mime-types
'(("json" . application/json) '(("json" . application/json)
("html" . text/html))) ("html" . text/html)
("txt" . text/plain)))
(define (ends-with-recognised-extension? path) (define (ends-with-recognised-extension? path)
(any (lambda (extension) (any (lambda (extension)