Fixes in token case-sensitivity, hex color parsing and stringification

Makefile

@@ -35,6 +35,8 @@ parser.mli: parser.ml
 parse.cmx: lexer.cmi parser.cmx
 util.cmx: stringify.cmx
 main.cmx: parse.cmx util.cmx
+stringify.cmx parser.cmi parser.cmx lexer.cmx util.cmx parse.cmx main.cmx: \
+	types.cmi
 
 clean:
 	rm -f *.cmi *.cmx *.o lexer.ml parser.ml parser.mli parser.conflicts \

lexer.mll

@@ -15,30 +15,30 @@
   let strip_quotes s = String.sub s 1 (String.length s - 2)
 }
 
-let h           = ['0'-'9''a'-'f']
-let wc          = '\r''\n' | [' ''\t''\r''\n''\012']
+let h           = ['0'-'9' 'a'-'f' 'A'-'F']
+let wc          = '\r' '\n' | [' ' '\t' '\r' '\n' '\012']
 let nonascii    = ['\160'-'\255']
-let s           = [' ''\t''\r''\n''\012']+
+let s           = [' ' '\t' '\r' '\n' '\012']+
 let w           = s?
-let nl          = '\n' | '\r''\n' | '\r' | '\012'
+let nl          = '\n' | '\r' '\n' | '\r' | '\012'
 let unicode     = '\\' h(h(h(h(h(h)?)?)?)?)? wc?
-let escape      = unicode | '\\'[^'\r''\n''\012''0'-'9''a'-'f']
-let nmstart     = ['_''a'-'z'] | nonascii | escape
-let nmchar      = ['_''a'-'z''0'-'9''-'] | nonascii | escape
-let string1     = '"'([^'\n''\r''\012''"'] | '\\'nl | escape)*'"'
-let string2     = '\''([^'\n''\r''\012''\''] | '\\'nl | escape)*'\''
+let escape      = unicode | '\\'[^'\r' '\n' '\012' '0'-'9' 'a'-'f' 'A'-'F']
+let nmstart     = ['_' 'a'-'z' 'A'-'Z'] | nonascii | escape
+let nmchar      = ['_' 'a'-'z' 'A'-'Z' '0'-'9' '-'] | nonascii | escape
+let string1     = '"'([^'\n' '\r' '\012' '"'] | '\\'nl | escape)*'"'
+let string2     = '\'' ([^'\n' '\r' '\012' '\''] | '\\' nl | escape)* '\''
 let mystring    = string1 | string2
-let badstring1  = '"'([^'\n''\r''\012''"'] | '\\'nl | escape)*'\\'?
-let badstring2  = '\''([^'\n''\r''\012''\''] | '\\'nl | escape)*'\\'?
+let badstring1  = '"' ([^'\n' '\r' '\012' '"'] | '\\'nl | escape)* '\\'?
+let badstring2  = '\'' ([^'\n' '\r' '\012' '\''] | '\\'nl | escape)* '\\'?
 let badstring   = badstring1 | badstring2
-let badcomment1 = '/''*'[^'*']*'*'+([^'/''*'][^'*']*'*'+)*
-let badcomment2 = '/''*'[^'*']*('*'+[^'/''*'][^'*']*)*
+let badcomment1 = '/' '*'[^'*']*'*'+([^'/' '*'][^'*']*'*'+)*
+let badcomment2 = '/' '*'[^'*']*('*'+[^'/' '*'][^'*']*)*
 let badcomment  = badcomment1 | badcomment2
-let baduri1     = "url("w(['!''#''$''%''&''*'-'['']'-'~'] | nonascii | escape)*w
-let baduri2     = "url("w mystring w
-let baduri3     = "url("w badstring
+let baduri1     = "url(" w (['!' '#' '$' '%' '&' '*'-'[' ']'-'~'] | nonascii | escape)* w
+let baduri2     = "url(" w mystring w
+let baduri3     = "url(" w badstring
 let baduri      = baduri1 | baduri2 | baduri3
-let comment     = '/''*'[^'*']*'*'+([^'/''*'][^'*']*'*'+)'*''/'
+let comment     = "/*" [^'*']* '*'+ ([^'/' '*'] [^'*']* '*'+) "*/"
 let ident       = '-'? nmstart nmchar*
 let name        = nmchar+
 let num         = ['0'-'9']+ | ['0'-'9']*'.'['0'-'9']+

parser.mly

@@ -26,7 +26,7 @@
     let rec transform_ops = function
       | [] -> []
       | Term left :: Operator op :: Term right :: tl ->
-        Nary (op, [left; right]) :: transform_ops tl
+        transform_ops (Term (Nary (op, [left; right])) :: tl)
       | Term hd :: tl -> hd :: transform_ops tl
       | Operator op :: _ -> raise (SyntaxError ("unexpected operator \"" ^ op ^ "\""))
     in
@@ -36,13 +36,7 @@
         Nary (op, flatten_nary left @ flatten_nary right) :: flatten_nary tl
       | hd :: tl -> hd :: flatten_nary tl
     in
-    let comma_to_concat =
-      List.map (transform_value (function
-        | Nary (",", terms) -> Concat terms
-        | value -> value
-      ))
-    in
-    match terms |> transform_ops |> flatten_nary |> comma_to_concat with
+    match terms |> transform_ops |> flatten_nary with
     | [hd] -> hd
     | l -> Concat l
 %}
@@ -79,15 +73,15 @@ stylesheet:
   { s }
 
 charset:
-  | CHARSET_SYM name=STRING SEMICOL
+  | CHARSET_SYM S? name=STRING S? SEMICOL
   { Charset name }
 
-%inline string_or_uri:
-  | s=STRING | s=URI
-  { s }
 import:
   | IMPORT_SYM S? tgt=string_or_uri media=wslist(COMMA, IDENT) SEMICOL S?
   { Import (tgt, media) }
+%inline string_or_uri:
+  | str=STRING  { Strlit str }
+  | uri=URI     { Uri uri }
 
 media:
   | MEDIA_SYM queries=wslist(COMMA, IDENT) LBRACE S? rulesets=ruleset* RBRACE S?
@@ -112,12 +106,12 @@ ruleset:
   { Ruleset (selectors_hd :: selectors_tl, decls) }
 
 selector:
-  | hd=simple_selector S?
-  { [hd] }
-  | hd=simple_selector S tl=selector
-  { hd :: tl }
-  | hd=simple_selector S? c=combinator tl=selector
-  { hd :: c :: tl }
+  | simple=simple_selector S?
+  { Simple simple }
+  | left=simple_selector S right=selector
+  { Combinator (Simple left, " ", right) }
+  | left=simple_selector S? com=combinator right=selector
+  { Combinator (Simple left, com, right) }
 %inline combinator:
   | PLUS S?          { "+" }
   | c=COMBINATOR S?  { c }
@@ -145,7 +139,7 @@ attrib:
     "[" ^ left ^ right ^ "]" }
 %inline rel_value:
   | S? id=IDENT S?  { id }
-  | S? s=STRING S?  { s }
+  | S? s=STRING S?  { "\"" ^ s ^ "\"" }
 
 pseudo:
   | COLON id=IDENT
@@ -156,7 +150,7 @@ pseudo:
 
 declaration:
   | name=IDENT S? COLON S? value=expr important=boption(pair(IMPORTANT_SYM, S?))
-  { (name, value, important) }
+  { (String.lowercase name, value, important) }
 
 expr:
   | l=exprl             { concat_terms l }
@@ -187,9 +181,11 @@ term:
   | fn=FUNCTION arg=expr RPAREN S?
   { Function (fn, arg) }
   | hex=HASH S?
-  { if Str.string_match (Str.regexp "\\d{3}\\d{3}?") hex 0
-      then Hexcolor hex
+  { let h = "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]" in
+    if Str.string_match (Str.regexp ("^" ^ h ^ "\\(" ^ h ^ "\\)?$")) hex 0
+      then Hexcolor (String.lowercase hex)
       else raise (SyntaxError ("invalid color #" ^ hex)) }
-%inline unary_operator:
+
+unary_operator:
   | MINUS  { "-" }
   | PLUS   { "+" }

stringify.ml

@@ -14,6 +14,10 @@ let string_of_num n =
     then string_of_int (int_of_float n)
     else string_of_float n
 
+(*
+ * Pretty-printing
+ *)
+
 let rec string_of_expr = function
   | Ident id -> id
   | Strlit str -> "\"" ^ str ^ "\""
@@ -25,25 +29,33 @@ let rec string_of_expr = function
   | Function (name, arg) -> name ^ "(" ^ string_of_expr arg ^ ")"
   | Hexcolor hex -> "#" ^ hex
   | Unary (op, opnd) -> op ^ string_of_expr opnd
+  | Nary (",", opnds) -> cat ", " string_of_expr opnds
   | Nary (op, opnds) -> cat op string_of_expr opnds
 
 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
+  | Combinator (left, " ", right) ->
+    string_of_selector left ^ " " ^ string_of_selector right
+  | Combinator (left, com, right) ->
+    string_of_selector left ^ " " ^ com ^ " " ^ string_of_selector right
+
 let block body = " {\n" ^ indent body ^ "\n}"
 
 let rec string_of_statement = function
   | Ruleset (selectors, decls) ->
-    cat ", " (String.concat " ") selectors ^
+    cat ", " string_of_selector selectors ^
     block (cat "\n" string_of_declaration decls)
   | Media (queries, rulesets) ->
     "@media " ^ String.concat ", " queries ^
     block (cat "\n\n" string_of_statement rulesets)
-  | Import (filename, []) ->
-    "@import \"" ^ filename ^ "\";"
-  | Import (filename, queries) ->
-    "@import \"" ^ filename ^ "\" " ^ String.concat ", " queries ^ ";"
+  | Import (target, []) ->
+    "@import " ^ string_of_expr target ^ ";"
+  | Import (target, queries) ->
+    "@import " ^ string_of_expr target ^ " " ^ String.concat ", " queries ^ ";"
   | Charset charset ->
     "@charset \"" ^ charset ^ "\";"
   | Page (None, decls) ->
@@ -58,3 +70,45 @@ let rec string_of_statement = function
     "@namespace " ^ prefix ^ " \"" ^ uri ^ "\";"
 
 let string_of_stylesheet = cat "\n\n" string_of_statement
+
+(*
+ * Minified stringification
+ *)
+
+let rec minify_expr = function
+  | Concat values -> cat " " minify_expr values
+  | Function (name, arg) -> name ^ "(" ^ minify_expr arg ^ ")"
+  | Unary (op, opnd) -> op ^ minify_expr opnd
+  | Nary (",", opnds) -> cat "," minify_expr opnds
+  | Nary (op, opnds) -> cat op minify_expr opnds
+  | expr -> string_of_expr expr
+
+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_statement = function
+  | Ruleset (selectors, decls) ->
+    cat "," minify_selector selectors ^
+    "{" ^ (cat ";" minify_declaration decls) ^ "}"
+  | Media (queries, rulesets) ->
+    "@media " ^ String.concat "," queries ^
+    "{" ^ (cat "" minify_statement rulesets) ^ "}"
+  | Import (target, []) ->
+    "@import " ^ string_of_expr target ^ ";"
+  | Import (target, queries) ->
+    "@import " ^ string_of_expr target ^ " " ^ String.concat "," queries ^ ";"
+  | Page (None, decls) ->
+    "@page{" ^ cat "" minify_declaration decls ^ "}"
+  | Page (Some pseudo, decls) ->
+    "@page :" ^ pseudo ^ "{" ^ cat "" minify_declaration decls ^ "}"
+  | Fontface decls ->
+    "@font-face{" ^ cat "" minify_declaration decls ^ "}"
+  | statement -> string_of_statement statement
+
+let minify_stylesheet = cat "" minify_statement

types.ml

@@ -11,15 +11,17 @@ type expr =
 
 type declaration = string * expr * bool
 
-type selector = string list
+type selector =
+  | Simple of string
+  | Combinator of selector * string * selector
 
 type statement =
   | Ruleset of selector list * declaration list
   (* <selectors> { <declarations> } *)
   | Media of string list * statement list
   (* @media <queries> { <rulesets> } *)
-  | Import of string * string list
-  (* @import "<file>" [<media>]; *)
+  | Import of expr * string list
+  (* @import <target> [<media>]; *)
   | Charset of string
   (* @charset "<charset>"; *)
   | Page of string option * declaration list