Started implementing @supports

lexer.mll

@@ -95,10 +95,12 @@ rule token = parse
   | '@' F O N T '-' F A C E  { FONT_FACE_SYM }
   | '@' N A M E S P A C E    { NAMESPACE_SYM }
   | '@' K E Y F R A M E S    { KEYFRAMES_SYM }
+  | '@' S U P P O R T S      { SUPPORTS_SYM }
 
   | O N L Y             { ONLY }
   | N O T               { NOT }
   | A N D               { AND }
+  | O R                 { OR }
   | F R O M             { FROM }
   | T O                 { TO }
 

parser.mly

@@ -44,12 +44,12 @@
 
 (* Tokens *)
 %token S CDO CDC IMPORT_SYM PAGE_SYM MEDIA_SYM CHARSET_SYM FONT_FACE_SYM
-%token NAMESPACE_SYM KEYFRAMES_SYM IMPORTANT_SYM
+%token NAMESPACE_SYM KEYFRAMES_SYM SUPPORTS_SYM IMPORTANT_SYM
 %token <float> PERCENTAGE NUMBER
 %token <float * string> UNIT_VALUE
 %token <string> COMBINATOR RELATION STRING IDENT HASH URI FUNCTION
 %token LPAREN RPAREN LBRACE RBRACE LBRACK RBRACK SEMICOL COLON COMMA DOT PLUS
-%token MINUS SLASH STAR ONLY AND NOT FROM TO EOF
+%token MINUS SLASH STAR ONLY AND OR NOT FROM TO EOF
 
 (* Start symbol *)
 %type <Types.stylesheet> stylesheet
@@ -67,15 +67,20 @@ stylesheet:
   | charset    = charset? S? cd*
     imports    = terminated(import, cd*)*
     namespaces = terminated(namespace, cd*)*
-    statements = terminated(statement, cd*)*
+    statements = terminated(nested_statement, cd*)*
                  EOF
   { let charset = match charset with None -> [] | Some c -> [c] in
     charset @ imports @ namespaces @ statements }
 
-statement:
-  | s=ruleset | s=media | s=page | s=font_face | s=keyframes
+nested_statement:
+  | s=ruleset | s=media | s=page | s=font_face_rule | s=keyframes_rule
+  | s=supports_rule
   { s }
 
+group_rule_body:
+  | LBRACE S? statements=nested_statement* RBRACE S?
+  { statements }
+
 charset:
   | CHARSET_SYM name=STRING S? SEMICOL
   { Charset name }
@@ -95,7 +100,7 @@ namespace:
   { prefix }
 
 media:
-  | MEDIA_SYM queries=media_query_list LBRACE S? rulesets=ruleset* RBRACE S?
+  | MEDIA_SYM queries=media_query_list rulesets=group_rule_body
   { Media (queries, rulesets) }
 media_query_list:
   | S?
@@ -125,7 +130,7 @@ pseudo_page:
   | COLON pseudo=IDENT S?
   { pseudo }
 
-font_face:
+font_face_rule:
   | FONT_FACE_SYM S? LBRACE S? hd=descriptor_declaration?
     tl=wspreceded(SEMICOL, descriptor_declaration?)* RBRACE S?
   { Font_face (filter_none (hd :: tl)) }
@@ -133,7 +138,7 @@ descriptor_declaration:
   | name=property COLON S? value=expr
   { (name, value) }
 
-keyframes:
+keyframes_rule:
   | KEYFRAMES_SYM S? id=IDENT S? LBRACE S? rules=keyframe_ruleset* RBRACE S?
   { Keyframes (id, rules) }
 keyframe_ruleset:
@@ -144,6 +149,47 @@ keyframe_selector:
   | TO            { Ident "to" }
   | n=PERCENTAGE  { Number (n, Some "%") }
 
+supports_rule:
+  | SUPPORTS_SYM S? cond=supports_condition S? body=group_rule_body
+  { Supports (cond, body) }
+supports_condition:
+  | c=supports_negation
+  | c=supports_conjunction
+  | c=supports_disjunction
+  | c=supports_condition_in_parens
+  { c }
+supports_condition_in_parens:
+  | LPAREN S? c=supports_condition S? RPAREN
+  | c=supports_declaration_condition
+  (*XXX: | c=general_enclosed*)
+  { c }
+supports_negation:
+  | NOT S c=supports_condition_in_parens
+  { Not c }
+supports_conjunction:
+  | hd=supports_condition_in_parens tl=preceded(delimited(S, AND, S), supports_condition_in_parens)+
+  { And (hd :: tl) }
+supports_disjunction:
+  | hd=supports_condition_in_parens tl=preceded(delimited(S, OR, S), supports_condition_in_parens)+
+  { Or (hd :: tl) }
+supports_declaration_condition:
+  | LPAREN S? decl=declaration RPAREN
+  { Decl decl }
+  (*XXX:
+general_enclosed:
+  | ( FUNCTION | LPAREN ) ( any | unused )* RPAREN
+  {  }
+
+any:
+[ IDENT | NUMBER | PERCENTAGE | DIMENSION | STRING
+              | DELIM | URI | HASH | UNICODE-RANGE | INCLUDES
+              | DASHMATCH | ':' | FUNCTION S* [any|unused]* ')'
+              | '(' S* [any|unused]* ')' | '[' S* [any|unused]* ']'
+              ]
+S*;
+unused      : block | ATKEYWORD S* | ';' S* | CDO S* | CDC S*;
+  *)
+
 %inline decls_block:
   | LBRACE S? hd=declaration? tl=wspreceded(SEMICOL, declaration?)* RBRACE S?
   { filter_none (hd :: tl) }

stringify.ml

@@ -17,11 +17,19 @@ let string_of_num n =
     else string_of_float n
 
 (* TODO: move this to utils *)
+let (@@) f g x = f (g x)
+
 let rec filter_none = function
   | [] -> []
   | None :: tl -> filter_none tl
   | Some hd :: tl -> hd :: filter_none tl
 
+let add_parens s =
+  let l = String.length s in
+  if l > 0 & s.[0] = '(' & s.[l - 1] = ')'
+    then String.sub s 1 (l - 2)
+    else s
+
 (*
  * Pretty-printing
  *)
@@ -68,6 +76,13 @@ let string_of_media_query query =
   | (Some pre, None, _) ->
     failwith "unexpected media query prefix \"" ^ pre ^ "\""
 
+let rec string_of_condition = function
+  | Not c -> "not " ^ add_parens (string_of_condition c)
+  | And c -> cat " and " (add_parens @@ string_of_condition) c
+  | Or c -> cat " or " (add_parens @@ string_of_condition) c
+  | Decl (name, value, false) -> "(" ^ name ^ ": " ^ string_of_expr value ^ ")"
+  | Decl (_, _, true) -> failwith "unexpected \"!important\""
+
 let block = function "" -> " {}" | body -> " {\n" ^ indent body ^ "\n}"
 
 let rec string_of_statement = function
@@ -101,6 +116,9 @@ let rec string_of_statement = function
       string_of_expr expr ^ block (cat "\n" string_of_declaration decls)
     in
     "@keyframes " ^ id ^ block (cat "\n\n" string_of_keyframe_ruleset rules)
+  | Supports (condition, statements) ->
+    "@supports " ^ string_of_condition condition ^
+    block (cat "\n\n" string_of_statement statements)
 
 let string_of_stylesheet = cat "\n\n" string_of_statement
 
@@ -138,6 +156,13 @@ let minify_media_query query =
     pre ^ " " ^ mtype ^ " and " ^ features_str features
   | _ -> string_of_media_query query
 
+let rec minify_condition = function
+  | Not c -> "not " ^ add_parens (minify_condition c)
+  | And c -> cat "and " (add_parens @@ minify_condition) c
+  | Or c -> cat "or " (add_parens @@ minify_condition) c
+  | Decl (name, value, false) -> "(" ^ name ^ ":" ^ minify_expr value ^ ")"
+  | Decl (_, _, true) -> failwith "unexpected \"!important\""
+
 let rec minify_statement = function
   | Ruleset (selectors, decls) ->
     cat "," minify_selector selectors ^
@@ -163,6 +188,9 @@ let rec minify_statement = function
       minify_expr expr ^ "{" ^ cat ";" minify_declaration decls ^ "}"
     in
     "@keyframes " ^ id ^ "{" ^ cat "" minify_keyframe_ruleset rules ^ "}"
+  | Supports (condition, statements) ->
+    "@supports " ^ minify_condition condition ^
+    "{" ^ cat "" minify_statement statements ^ "}"
   | statement -> string_of_statement statement
 
 let minify_stylesheet = cat "" minify_statement

types.ml

@@ -22,6 +22,13 @@ type descriptor_declaration = string * expr
 
 type keyframe_ruleset = expr * declaration list
 
+type condition =
+  | Not of condition
+  | And of condition list
+  | Or of condition list
+  | Decl of declaration
+  (*XXX: | Enclosed of expr*)
+
 type statement =
   | Ruleset of selector list * declaration list
   (* <selectors> { <declarations> } *)
@@ -38,7 +45,10 @@ type statement =
   | Namespace of string option * expr
   (* @namespace [<prefix>] "<uri>"; *)
   | Keyframes of string * keyframe_ruleset list
-  (* TODO: @document, @supports *)
+  (* @keyframes <id> { <rulesets> } *)
+  | Supports of condition * statement list
+  (* @supports <condition> { <rulesets> } *)
+  (* TODO: @document *)
 
 type stylesheet = statement list