Commit ec3626d8 authored by amirouche's avatar amirouche

improve scheme style

parent 6111c2ca
...@@ -20,19 +20,20 @@ exec guile -L $(pwd) -e '(@ (web) main)' -s "$0" "$@" ...@@ -20,19 +20,20 @@ exec guile -L $(pwd) -e '(@ (web) main)' -s "$0" "$@"
(define-module (web)) (define-module (web))
;; stdlib ;; stdlib
(use-modules (ice-9 match)) (use-modules ((ice-9 match)))
(use-modules (web request)) (use-modules ((web request)))
(use-modules (web server)) (use-modules ((web server)))
(use-modules (web uri)) (use-modules ((web uri)))
;; local ;; local
(use-modules (web decode)) (use-modules ((web decode)))
(use-modules (web helpers)) (use-modules ((web helpers)))
(use-modules (web html)) (use-modules ((web html)))
(use-modules (web mime-types)) (use-modules ((web lorem-ipsum)))
(use-modules (web static)) (use-modules ((web mime-types)))
(use-modules (web validate)) (use-modules ((web static)))
(use-modules (web lorem-ipsum)) (use-modules ((web style)))
(use-modules ((web validate)))
(setlocale LC_ALL "") (setlocale LC_ALL "")
...@@ -162,23 +163,6 @@ exec guile -L $(pwd) -e '(@ (web) main)' -s "$0" "$@" ...@@ -162,23 +163,6 @@ exec guile -L $(pwd) -e '(@ (web) main)' -s "$0" "$@"
`(p (@ (class "error")) ,error) `(p (@ (class "error")) ,error)
'())) '()))
(define (make-value value)
(match value
((? string? string) string)
((? symbol? symbol) (symbol->string symbol))))
(define (make-style alist)
(let loop ((alist alist)
(out ""))
(if (null? alist)
(string-append out ";")
(loop (cdr alist)
(string-append out
"; "
(symbol->string (caar alist))
": "
(make-value (cdar alist)))))))
(define (make-class alist) (define (make-class alist)
"Create html class attribute with an ALIST" "Create html class attribute with an ALIST"
(let loop ((alist alist) (let loop ((alist alist)
...@@ -195,7 +179,9 @@ exec guile -L $(pwd) -e '(@ (web) main)' -s "$0" "$@" ...@@ -195,7 +179,9 @@ exec guile -L $(pwd) -e '(@ (web) main)' -s "$0" "$@"
(confirmation-error (assoc-ref errors "confirmation"))) (confirmation-error (assoc-ref errors "confirmation")))
(template "signup" (template "signup"
`(form (@ (method "POST") `(form (@ (method "POST")
(style ,(make-style `((border . "1px solid black"))))) (style ,(make-style
`((border . ("1px" solid (hsla 300 50 50 1)))
(background . (hsla 200 50 50 1))))))
(h2 "Sign up") (h2 "Sign up")
(div (@ (class ,(make-class `(("form-item" . #t) (div (@ (class ,(make-class `(("form-item" . #t)
("error" . ,login-error))))) ("error" . ,login-error)))))
......
(define-module (web style))
(use-modules ((ice-9 match)))
(define (->string value)
(match value
(('hsla h s l a) (format #f "hsla(~a, ~a%, ~a%, ~a)" h s l a))
((? string? string) string)
((? symbol? symbol) (symbol->string symbol))))
(define (make-value value)
(match value
(('hsla h s l a) (format #f "hsla(~a, ~a%, ~a%, ~a)" h s l a))
((? pair? lst) (string-join (map ->string lst) " "))
(_ (->string value))))
(define-public (make-style alist)
(let loop ((alist alist)
(out ""))
(if (null? alist)
(string-append out ";")
(loop (cdr alist)
(string-append out
"; "
(symbol->string (caar alist))
": "
(make-value (cdar alist)))))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment