Extended 'Simple' selector type to algebraic data types

Makefile

 RESULT    := mincss
 PRE_TGTS  := types
-MODULES   := color_names util stringify parser lexer parse color shorthand main
+MODULES   := color_names util stringify parser lexer parse color \
+             shorthand main
 ALL_NAMES := $(PRE_TGTS) $(MODULES)
 
 OCAMLCFLAGS  := -g

parser.mly

@@ -37,6 +37,18 @@
     | Unary ("-", Number (n, u)) -> Number (-.n, u)
     | Unary ("+", (Number _ as n)) -> n
     | value -> value
+
+  let rec append_addons base = function
+    | [] ->
+      base
+    | `Id id :: tl ->
+      append_addons (Id (base, id)) tl
+    | `Class cls :: tl ->
+      append_addons (Class (base, cls)) tl
+    | `Attribute (attr, value) :: tl ->
+      append_addons (Attribute (base, attr, value)) tl
+    | `Pseudo (f, args) :: tl ->
+      append_addons (Pseudo (base, f, args)) tl
 %}
 
 (* Tokens *)
@@ -207,39 +219,44 @@ ruleset:
 
 selector:
   | simple=simple_selector S*
-  { Simple simple }
+  { simple }
   | left=simple_selector S+ right=selector
-  { Combinator (Simple left, " ", right) }
+  { Combinator (left, " ", right) }
   | left=simple_selector S* com=combinator right=selector
-  { Combinator (Simple left, com, right) }
+  { Combinator (left, com, right) }
 %inline combinator:
   | PLUS S*          { "+" }
   | c=COMBINATOR S*  { c }
 
 simple_selector:
   | elem=element_name addons=element_addon*
-  { elem ^ String.concat "" addons }
+  { append_addons elem addons }
   | addons=element_addon+
-  { String.concat "" addons }
-%inline element_addon: a=HASH | a=cls | a=attrib | a=pseudo { a }
+  { append_addons No_element addons }
+%inline element_addon:
+  | id=HASH       { `Id id }
+  | addon=cls
+  | addon=attrib
+  | addon=pseudo  { addon }
 element_name:
-  | tag=IDENT  { String.lowercase tag }
-  | STAR       { "*" }
+  | tag=IDENT  { Element (String.lowercase tag) }
+  | STAR       { All_elements }
 cls:
   | DOT name=IDENT
-  { "." ^ name }
+  { `Class name }
 attrib:
-  | LBRACK S* left=IDENT S* right=pair(RELATION, rel_value)? RBRACK
-  { let right = match right with None -> "" | Some (op, term) -> op ^ term in
-    "[" ^ String.lowercase left ^ right ^ "]" }
+  | LBRACK S* left=IDENT S* RBRACK
+  { `Attribute (String.lowercase left, None) }
+  | LBRACK S* left=IDENT S* op=RELATION right=rel_value RBRACK
+  { `Attribute (String.lowercase left, Some (op, right)) }
 %inline rel_value:
-  | S* id=IDENT S*  { id }
-  | S* s=STRING S*  { "\"" ^ s ^ "\"" }
+  | S* id=IDENT S*  { Ident id }
+  | S* s=STRING S*  { Strlit s }
 pseudo:
   | COLON id=IDENT
-  { ":" ^ (String.lowercase id) }
+  { `Pseudo (String.lowercase id, None) }
   | COLON f=FUNCTION args=wslist(COMMA, simple_selector) RPAREN
-  { ":" ^ String.lowercase f ^ "(" ^ String.concat "," args ^ ")" }
+  { `Pseudo (String.lowercase f, Some args) }
 
 declaration:
   | name=property S* COLON S* value=expr important=boption(ig2(IMPORTANT_SYM, S*))

stringify.ml

@@ -39,12 +39,30 @@ let string_of_declaration (name, value, important) =
   let imp = if important then " !important" else "" in
   name ^ ": " ^ string_of_expr value ^ imp ^ ";"
 
-let rec string_of_selector = function
-  | Simple simple -> simple
+let rec stringify_selector w selector =
+  let str = stringify_selector w in
+  match selector with
+  | No_element   -> ""
+  | All_elements -> "*"
+  | Element elem -> elem
+  | Id (base, id) ->
+    str base ^ "#" ^ id
+  | Class (base, cls) ->
+    str base ^ "." ^ cls
+  | Attribute (base, attr, None) ->
+    str base ^ "[" ^ attr ^ "]"
+  | Attribute (base, attr, Some (op, value)) ->
+    str base ^ "[" ^ attr ^ w ^ op ^ w ^ string_of_expr value ^ "]"
+  | Pseudo (base, sel, None) ->
+    str base ^ ":" ^ sel
+  | Pseudo (base, fn, Some args) ->
+    str base ^ ":" ^ fn ^ "(" ^ cat ("," ^ w) str args ^ ")"
   | Combinator (left, " ", right) ->
-    string_of_selector left ^ " " ^ string_of_selector right
+    str left ^ " " ^ str right
   | Combinator (left, com, right) ->
-    string_of_selector left ^ " " ^ com ^ " " ^ string_of_selector right
+    str left ^ w ^ com ^ w ^ str right
+
+let string_of_selector = stringify_selector " "
 
 let string_of_media_expr = function
   | (feature, None) -> "(" ^ feature ^ ")"
@@ -140,10 +158,7 @@ let minify_declaration (name, value, important) =
   let imp = if important then "!important" else "" in
   name ^ ":" ^ minify_expr value ^ imp
 
-let rec minify_selector = function
-  | Simple simple -> simple
-  | Combinator (left, com, right) ->
-    minify_selector left ^ com ^ minify_selector right
+let rec minify_selector = stringify_selector ""
 
 let minify_media_feature = function
   | (feature, None) -> "(" ^ feature ^ ")"

types.ml

@@ -11,9 +11,21 @@ type expr =
 
 type declaration = string * expr * bool
 
+type selector =
+  | No_element
+  | All_elements
+  | Element of string
+  | Id of selector * string
+  | Class of selector * string
+  | Pseudo of selector * string * selector list option
+  | Attribute of selector * string * (string * expr) option
+  | Combinator of selector * string * selector
+
+  (*
 type selector =
   | Simple of string
   | Combinator of selector * string * selector
+  *)
 
 type media_expr = string * expr option
 type media_query = string option * string option * media_expr list

util.ml

@@ -132,12 +132,26 @@ let transform_stylesheet f stylesheet =
   in
   let TRAV_ALL(declaration, Declaration) in
 
-  let trav_selector = function
-    | Simple _ as s -> f (Selector s)
+  let rec trav_selector = function
+    | (No_element | All_elements | Element _) as elem ->
+      f (Selector elem)
+    | Id (base, id) ->
+      f (Selector (Id (expect_selector base, id)))
+    | Class (base, cls) ->
+      f (Selector (Class (expect_selector base, cls)))
+    | Attribute (base, attr, value) ->
+      f (Selector (Attribute (expect_selector base, attr, value)))
+    | Pseudo (base, sel, None) ->
+      f (Selector (Pseudo (expect_selector base, sel, None)))
+    | Pseudo (base, fn, Some args) ->
+      let args = trav_all_selector args in
+      f (Selector (Pseudo (expect_selector base, fn, Some args)))
     | Combinator (left, com, right) ->
+      let left = expect_selector left in
+      let right = expect_selector right in
       f (Selector (Combinator (left, com, right)))
-  in
-  let TRAV_ALL(selector, Selector) in
+  and EXPECT(selector, Selector)
+  and TRAV_ALL(selector, Selector) in
 
   let trav_media_expr = function
     | (_, None) as value ->