conscript: add ~url

MarcKaufmann · Feb 13, 2024 · 26139b7 · 26139b7
1 parent d818c46
commit 26139b7
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 1 deletion.
diff --git a/conscript/base.rkt b/conscript/base.rkt
@@ -9,6 +9,8 @@
          (except-in congame/components/study button form)
          congame/components/for-study
          congame/components/transition-graph
+         net/url
+         racket/contract/base
          racket/format
          racket/lazy-require
          racket/list
@@ -222,6 +224,23 @@
     (get #:root (string->symbol (format "*dynamic:~a*" uid)) k)))
 
 
+;; util ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(provide
+ (contract-out
+  [~url (->* [string?]
+             [#:params (listof (cons/c symbol? string?))]
+             string?)]))
+
+(define (~url urlish #:params [params null])
+  (define u
+    (string->url
+     (if (not (regexp-match? #rx"^[^:]+?://" urlish))
+         (string-append "https://" urlish)
+         urlish)))
+  (url->string (struct-copy url u [query params])))
+
+
 ;; widgets ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (provide

diff --git a/conscript/html-element.rkt b/conscript/html-element.rkt
@@ -1,7 +1,7 @@
 #lang racket/base
 
 (require (for-syntax racket/base
-                     syntax/parse))
+                     syntax/parse/pre))
 
 (define (make-element id required-kwds)
   (make-keyword-procedure