css-tools/math.rkt

#lang racket/base
(require "core.rkt" racket/match racket/contract racket/string racket/list sugar/unstable/container sugar/coerce)

(define/contract (css-unit? x)
  (any/c . -> . boolean?)
  (x . in? . '("%" "in" "cm" "mm" "em" "ex" "pt" "pc" "px" "rem")))

(struct cssq (num unit)   
  #:methods gen:custom-write
  [(define write-proc 
     (λ(x port mode) (display (format "~a~a" (cssq-num x) (cssq-unit x)) port)))])

(define/contract (cssqish? x)
  (any/c . -> . boolean?)
  (->boolean (or (cssq? x) (string? x))))

(define/contract (string->unit x)
  (string? . -> . css-unit?)
  (if (css-unit? x)
      x
      (error 'string->unit "'~a' not a valid css unit" x)))

(define/contract (cssqish->cssq x)
  (cssqish? . -> . cssq?)
  (cond
    [(cssq? x) x]
    [else (begin
            (define pieces (let* ([str (string-downcase x)]
                                  [str (string-replace str " " "")]
                                  [str (string-trim str "s" #:left? #f)])
                             (string-split str #px"(?<![A-Za-z])(?=[A-Za-z])")))
            (apply cssq 
                   (with-handlers ([exn:fail? (λ(e) (error 'string->cssq (exn-message e)))])
                     (list (string->number (first pieces)) 
                           (string->unit (second pieces))))))]))

(define/contract (css-math-op op left right)
  (procedure? cssqish? cssqish? . -> . cssq?)
  (let ([left (cssqish->cssq left)]
        [right (cssqish->cssq right)])
    (cssqish->cssq (format "~a~a" (apply op (list (cssq-num left) (cssq-num right)))(cssq-unit left)))))

(define-values (css+ css- css* css/)
  (apply values (map (λ(op) (λ(left right) (css-math-op op left right))) (list + - * /))))

(module+ main
  (css+ "10rem" "5rem"))