<commit_before>#lang racket

(require "common.rkt" "tree.rkt" "spec/css-properties.rkt" "z3.rkt" "smt.rkt" "modular-synthesis.rkt" "dom.rkt")
(module+ test (require rackunit))
(provide equivalence-classes equivalence-classes-avoid?
         selector-matches? all-selectors synthesize-css-sketch
         css-sketch-solver rule-matchlist (struct-out rulematch))



(define (property? sym)
  (and (symbol? sym)
       (for/first ([(property type default) (in-css-properties)] #:when (equal? property sym)) true)))

(define-by-match selector?
  `*
  `(id ,(? symbol?))
  `(class ,(? symbol?))
  `(tag ,(? symbol?))
  `(and ,(? selector?) ...)
  `(desc ,(? selector?) ...)
  `(child ,(? selector?) ...)
  `(pseudo-class ,(or 'first-child 'last-child 'hover))
  `(type ,(? symbol?))
  `(media ,(? media-query?) ,(? selector?))
  `(fake ,(? string?) ,(? selector?) ...))

(define-by-match media-query?
  `(or ,(? media-query?) ...)
  `(and ,(? media-query?) ...)
  `(only ,(? media-query?))
  `(not ,(? media-query?))
  `(min-width (px ,(? number?)))
  `(max-width (px ,(? number?)))
  `(min-height (px ,(? number?)))
  `(max-height (px ,(? number?)))
  `(orientation landscape)
  `(orientation portrait)
  (or 'all 'screen 'print 'handheld 'projection 'tty 'tv))

(define-by-match rule?
  (list (? selector?) (? attribute?) ... (list (? property?) _ (? attribute?) ...) ...))

(define-by-match partial-rule?
  (list (? selector?) (? attribute?) ... (or (list (? property?) _ (? attribute?) ...) '?) ...))

(define/contract (selector-matches? sel elt)
  (-> selector? node? boolean?)
  "Given an element and a selector, returns whether the selector matches the element"
  (match sel
    [`(fake ,true ,subsels ...)
     (ormap (curryr selector-matches? elt) subsels)]
    [`* true]
    [`(id ,id)
     (define eid (and (node-get elt ':id) (slower (node-get elt ':id))))
     (when (equal? eid '?)
       (raise (make-exn:fail:unsupported "Holes in identifiers are not supported" (current-continuation-marks))))
     (equal? eid id)]
    [`(class ,cls)
     (define ecls (map slower (node-get elt ':class #:default '())))
     (set-member? ecls cls)]
    [`(tag ,tag)
     (define etag (node-type elt))
     (when (equal? etag '?)
       (raise (make-exn:fail:unsupported "Holes in tag names are not supported" (current-continuation-marks))))
     (equal? etag tag)]
    [`(pseudo-class first-child) (not (node-prev elt))]
    [`(pseudo-class last-child) (not (node-next elt))]
    [`(pseudo-class hover) false] ; We're never modeling hovering
    [`(type ,type)
     (and (node-get elt ':type) (equal? (slower (node-get elt ':type)) type))]
    [`(media ,query ,sel)
     (and (media-matches? query) (selector-matches? sel elt))]
    [(list 'and sels ...) (andmap (curryr selector-matches? elt) sels)]
    [(list 'desc sels ...)
     (match-define (cons sel rsels) (reverse sels))
     (and (selector-matches? sel elt)
          (or (node-parent elt) (null? rsels))
          (let loop ([rsels rsels] [elt (node-parent elt)])
            (cond
             [(null? rsels) true]
             [(not (node-parent elt)) false]
             [(selector-matches? (car rsels) elt)
              (loop (cdr rsels) (node-parent elt))]
             [else
              (loop rsels (node-parent elt))])))]
    [(list 'child sels ...)
     (let loop ([rsels (reverse sels)] [elt elt])
       (cond
        [(null? rsels) true]
        [(not (node-parent elt)) false]
        [(selector-matches? (car rsels) elt)
         (loop (cdr rsels) (node-parent elt))]
        [else false]))]))

(define (media-matches? query)
  (match query
    [`(or ,qs ...)
     (ormap media-matches? qs)]
    [`(and ,qs ...)
     (andmap media-matches? qs)]
    [`(only ,q)
     (media-matches? q)]
    [`(not ,q)
     (not (media-matches? q))]
    ['screen true]
    ['all true]
    [(or 'print 'handheld 'projection 'tty 'tv) false]
    ['(orientation landscape) true] ; TODO: Actually check viewport width and height
    ['(orientation portrait) false]
    [`(max-width (px ,mw)) false]
    [`(min-width (px ,mw)) false]
    [`(max-height (px ,mh)) false]
    [`(min-height (px ,mh)) false]))

(module+ test
  (define tree
    '([html] ; 0
      ([body] ; 1
       ([div :id content] ; 2
        ([h1 :class (title)]) ; 3
        ([div :class (abstract)] ; 4
         ([blockquote] ; 5
          ([p]))) ; 6
        ([p]) ; 7
        ([div :class (aside)] ; 8
         ([p])))))) ; 9
  (define ptree (parse-tree tree))
  (define elts (sequence->list (in-tree ptree)))

  (define (check-selector sel ns)
    (for ([n (in-naturals)] [elt (in-list elts)])
      ((if (set-member? ns n) check-true check-false)
       (selector-matches? sel elt))))

  (check-selector '* (range 10))
  (check-selector '(id content) '(2))
  (check-selector '(tag html) '(0))<commit_msg>More style fixes<commit_after>#lang racket

(require "common.rkt" "tree.rkt" "spec/css-properties.rkt" "z3.rkt" "smt.rkt" "modular-synthesis.rkt" "dom.rkt")
(module+ test (require rackunit))
(provide equivalence-classes equivalence-classes-avoid?
         selector-matches? all-selectors synthesize-css-sketch
         css-sketch-solver rule-matchlist (struct-out rulematch))



(define (property? sym)
  (and (symbol? sym)
       (for/first ([(property type default) (in-css-properties)] #:when (equal? property sym)) true)))

(define-by-match selector?
  `*
  `(id ,(? symbol?))
  `(class ,(? symbol?))
  `(tag ,(? symbol?))
  `(and ,(? selector?) ...)
  `(desc ,(? selector?) ...)
  `(child ,(? selector?) ...)
  `(pseudo-class ,(or 'first-child 'last-child 'hover))
  `(type ,(? symbol?))
  `(media ,(? media-query?) ,(? selector?))
  `(fake ,(? string?) ,(? selector?) ...))

(define-by-match media-query?
  `(or ,(? media-query?) ...)
  `(and ,(? media-query?) ...)
  `(only ,(? media-query?))
  `(not ,(? media-query?))
  `(min-width (px ,(? number?)))
  `(max-width (px ,(? number?)))
  `(min-height (px ,(? number?)))
  `(max-height (px ,(? number?)))
  `(orientation landscape)
  `(orientation portrait)
  (or 'all 'screen 'print 'handheld 'projection 'tty 'tv))

(define-by-match rule?
  (list (? selector?) (? attribute?) ... (list (? property?) _ (? attribute?) ...) ...))

(define-by-match partial-rule?
  (list (? selector?) (? attribute?) ... (or (list (? property?) _ (? attribute?) ...) '?) ...))

(define/contract (selector-matches? sel elt)
  (-> selector? node? boolean?)
  "Given an element and a selector, returns whether the selector matches the element"
  (match sel
    [`(fake ,true ,subsels ...)
     (ormap (curryr selector-matches? elt) subsels)]
    [`* true]
    [`(id ,id)
     (define eid (and (node-get elt ':id) (slower (node-get elt ':id))))
     (when (equal? eid '?)
       (raise (make-exn:fail:unsupported "Holes in identifiers are not supported" (current-continuation-marks))))
     (equal? eid id)]
    [`(class ,cls)
     (define ecls (map slower (node-get elt ':class #:default '())))
     (set-member? ecls cls)]
    [`(tag ,tag)
     (define etag (node-type elt))
     (when (equal? etag '?)
       (raise (make-exn:fail:unsupported "Holes in tag names are not supported" (current-continuation-marks))))
     (equal? etag tag)]
    [`(pseudo-class first-child) (not (node-prev elt))]
    [`(pseudo-class last-child) (not (node-next elt))]
    [`(pseudo-class hover) false] ; We're never modeling hovering
    [`(type ,type)
     (and (node-get elt ':type) (equal? (slower (node-get elt ':type)) type))]
    [`(media ,query ,sel)
     (and (media-matches? query) (selector-matches? sel elt))]
    [(list 'and sels ...) (andmap (curryr selector-matches? elt) sels)]
    [(list 'desc sels ...)
     (match-define (cons sel rsels) (reverse sels))
     (and (selector-matches? sel elt)
          (or (node-parent elt) (null? rsels))
          (let loop ([rsels rsels] [elt (node-parent elt)])
            (cond
             [(null? rsels) true]
             [(not (node-parent elt)) false]
             [(selector-matches? (car rsels) elt)
              (loop (cdr rsels) (node-parent elt))]
             [else
              (loop rsels (node-parent elt))])))]
    [(list 'child sels ...)
     (let loop ([rsels (reverse sels)] [elt elt])
       (cond
        [(null? rsels) true]
        [(not (node-parent elt)) false]
        [(selector-matches? (car rsels) elt)
         (loop (cdr rsels) (node-parent elt))]
        [else false]))]))

(define (media-matches? query)
  (match query
    [`(or ,qs ...)
     (ormap media-matches? qs)]
    [`(and ,qs ...)
     (andmap media-matches? qs)]
    [`(only ,q)
     (media-matches? q)]
    [`(not ,q)
     (not (media-matches? q))]
    ['screen true]
    ['all true]
    [(or 'print 'handheld 'projection 'tty 'tv) false]
    ['(orientation landscape) true] ; TODO: Actually check viewport width and height
    ['(orientation portrait) false]
    [`(max-width (px ,mw)) false]
    [`(min-width (px ,mw)) false]
    [`(max-height (px ,mh)) false]
    [`(min-height (px ,mh)) false]))

(module+ test
  (define tree
    (parse-tree
     '([html] ; 0
       ([body] ; 1
        ([div :id content] ; 2
         ([h1 :class (title)]) ; 3
         ([div :class (abstract)] ; 4
          ([blockquote] ; 5
           ([p]))) ; 6
         ([p]) ; 7
         ([div :class (aside)] ; 8
          ([p]))))))) ; 9

  (define (check-selector sel ns)
    (for ([n (in-naturals)] [elt (in-tree tree)])
      ((if (set-member? ns n) check-true check-false)
       (selector-matches? sel elt))))

  (check-selector '* (range 10))
  (check-selector '(id content) '(2))
  (check-selector '(tag html) '(0))
{'fraction_non_alphanumeric': 0.20368826838924775, 'fraction_numerical': 0.003334027922483851, 'mean_word_length': 2.786587771203156, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 6, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '575976', 'n_tokens_mistral': 3537, 'n_tokens_neox': 3380, 'n_words': 929}