
(define Property:Property nil)
(Property "ATTR{idVendor}" '(setf _vendor (t 2)))
(Property "ATTRS{idVendor}" '(setf _vendor (t 2)))
(Property "ATTR{idProduct}" '(setf _product (t 2)))
(Property "ATTRS{idProduct}" '(setf _product (replace "*" (t 2) "")))
(Property "OWNER" '(format "OWNER=%s" (t 2)))
(Property "GROUP" '(format "GROUP=%s" (t 2)))
(Property "RUN" '(format "RUN=%s" (t 2)))
(Property "SYMLINK" '(format "SYMLINK=%s" (t 2)))
(Property "ENV{ID_SMARTCARD_READER}" "CATEGORY=smartcard")
(Property "ENV{ID_MEDIA_PLAYER}" '(format "CATEGORY=media_player:%s" (t 2)))
(Property "ENV{libsane_matched}" "CATEGORY=scanner")
(Property "IMPORT{program}" '(format "IMPORT=%s" (t 2)))

; (dist op A B) .. form (op a b) for all a in A and b in B
(define (dist op A B) ; ...
  (apply extend (map (fn (a) (map (curry op a) B)) A)))

; Add a string prefix to all elements of a string list
(define (add-prefix p l)
  (map (curry string p) l))

; Compose a pair (a b) of string and range patterns. NOT GENERAL SOLUTION
(define (compose c)
  (if (= "0-9A-F" (c 1)) (add-prefix (c 0) (explode "0123456789ABCDEF"))
    (= "" (c 1)) (list (c 0))
    (map (curry string (c 0)) (explode (c 1)))))

; Process an id expression that may include range(s). NOT GENERAL SOLUTION
(define (expand-range r)
  (let ((out '("")) (p (find-all "([-0-9A-F]*)[[\\]]" r $1)))
    (if p (dolist (x (explode p 2)) (setf out (dist string out (compose x))))
      (setf out (list r)))
    out))

; Process an id expression wrt containing alternatives. NOT GENERAL SOLUTION
(define (expand-alt-ranges _p)
  (apply extend (map expand-range (or (parse _p "|") '("")))))

# Compute the hwdb-stanza(s) for a given rule, and return it, or nil
(define (hwdb-stanza rule)
  (let ((_vendor nil) (_product "")(_props '())(e nil) (v nil))
    (dolist (t rule)
      (setf v (eval (setf e (Property (t 0)))))
      (when (and v e (!= 'setf (e 0))) (push v _props -1)))
    (if (and _vendor _props)
        (let ((_v (add-prefix "v" (expand-alt-ranges (upper-case _vendor))))
              (_p (add-prefix "p" (expand-alt-ranges (upper-case _product))))
              (hw (join _props "\n  ")))
          (when (exists (curry find "*") _p)
            (println rule))
          (join (map (fn (vp) (format "usb:%s*\n  %s\n\n" vp hw))
                     (dist string _v _p))))
      )))

"classifications.lsp"
