add hydrilla.koszko.org virtualhost

1 files changed, 90 insertions, 0 deletions

diff --git a/guix-module-dir/hydrilla-json-schemas.scm b/guix-module-dir/hydrilla-json-schemas.scm
new file mode 100644
index 0000000..a3a8dbe
--- /dev/null
+++ b/guix-module-dir/hydrilla-json-schemas.scm
@@ -0,0 +1,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)))