blob: a3a8dbeca99c741c859c6e44711648a4ba06b5f1 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
;; SPDX-License-Identifier: CC0-1.0
;; Copyright (C) 2022 Wojtek Kosior <koszko@koszko.org>
;;
;; Available under the terms of Creative Commons Zero v1.0 Universal.
(define-module (hydrilla-json-schemas)
#:use-module (guix packages)
#:use-module (guix gexp)
#:use-module (guix build-system copy)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (ice-9 match)
#:use-module (ice-9 popen)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-26))
(define %source-dir
(let* ((this-file (search-path %load-path "hydrilla-json-schemas.scm"))
(proj-dir (dirname (dirname this-file))))
(if (absolute-file-name? proj-dir)
proj-dir
(string-append (getcwd) "/" proj-dir))))
(define %schema-git-locations
'(("d94ef4544faac662f49bed41700c9010804b2450" "-2.schema.json")
("v1.0.1" "-1.0.1.schema.json")
("v1.0" "-1.schema.json")))
(define %schemas-subrepo
(string-append %source-dir "/subrepos/hydrilla/src/hydrilla/schemas/1.x"))
(define %schemas-dest
(string-append %source-dir "/schemas"))
(define* (run-git-in-subrepo #:rest args)
(apply open-pipe* (cons* OPEN_READ "git" "-C" %schemas-subrepo args)))
(define (filter-locations port file-ending)
(let ((regex (string-append "[^[:space:]]+" (regexp-quote file-ending) "$")))
(filter (lambda (val) (not (unspecified? val)))
(map (lambda (line)
(let ((match-result (string-match regex line)))
(when match-result (match:substring match-result 0))))
(string-split (read-string port) #\xA)))))
(define (get-git-file rev filename)
(let* ((port (run-git-in-subrepo "show" (string-append rev ":" filename)))
(contents (read-string port)))
(close-port port)
contents))
(define (write-schema-file filename contents)
(call-with-output-file (string-append %schemas-dest "/" filename)
(cut display contents <>)))
(define (transfer-file rev filename)
(write-schema-file filename (get-git-file rev filename)))
(define (prepare-schemas-directory)
(when (not (file-exists? %schemas-dest))
(mkdir %schemas-dest))
(for-each (match-lambda
((rev file-ending)
(let* ((port (run-git-in-subrepo "ls-tree" rev))
(filtered (filter-locations port file-ending)))
(close-port port)
(for-each (cut transfer-file rev <>) filtered))))
%schema-git-locations)
%schemas-dest)
(define-public hydrilla-json-schemas
(package
(name "hydrilla-json-schemas")
(version "current")
(source
(local-file (prepare-schemas-directory) #:recursive? #t))
(build-system copy-build-system)
(arguments
'(#:install-plan '(("." "share/hydrilla-json-schemas/"
#:include (".schema.json")))))
(home-page "https://git.koszko.org/hydrilla-json-schemas")
(synopsis
"JSON schemas used by Haketilo and Hydrilla")
(description "Haketilo HTTP proxy facilitates viewing of websites while
having their original JavaScript replaced by user-provided scripts. Haketilo
combines the functionalities of content blocker and user script manager. It can
be used with its script repository, Hydrilla. This package makes available the
JSON schemas describing various interfaces of Haketilo and Hydrilla.")
(license license:cc0)))
|
