Support nested declarations; now modular CSS is possible :-)

_tags

@@ -1 +1,2 @@
+true: debug
 <pa_lib> or <lib> or <lib_test>: include

lib/css.ml

@@ -21,23 +21,18 @@ module Css = struct
 
   and expr = elt list
 
-  type prop = string * expr list
-
-  type decl = expr list * prop list
+  type prop_decl =
+    | Prop of string * expr list
+    | Decl of expr list * prop_decl list
 
   type t =
-    | Props of prop list
-    | Decls of decl list
+    | Props of prop_decl list
     | Exprs of expr list
 
   let props = function
     | Props p -> p
     | _ -> raise Parsing.Parse_error 
 
-  let decls = function
-    | Decls d -> d
-    | _ -> raise Parsing.Parse_error
-
   let exprs = function
     | Exprs e -> e
     | _ -> raise Parsing.Parse_error
@@ -68,23 +63,16 @@ module Css = struct
       | [h]  -> fprintf ppf "%a" expr h
       | h::t -> fprintf ppf "%a, %a" expr h exprs t
 
-    let prop ppf (n, el) =
-      fprintf ppf "\t%s: %a;" n exprs el
-
-    let rec props ppf (pl : prop list) = match pl with
-      | []   -> ()
-      | h::t -> fprintf ppf "%a\n%a" prop h props t
-
-    let decl ppf (sl, pl) =
-      fprintf ppf "%a {\n%a}\n" exprs sl props pl
+    let rec prop_decl ppf = function
+      | Decl (el, pl) -> fprintf ppf "%a {\n%a\n}" exprs el prop_decls pl
+      | Prop (n, el)  -> fprintf ppf "\t%s: %a;" n exprs el
 
-    let rec decls ppf (dl : decl list) = match dl with
+    and prop_decls ppf = function
       | []   -> ()
-      | h::t -> fprintf ppf "%a\n%a" decl h decls t
+      | h::t -> fprintf ppf "%a\n%a" prop_decl h prop_decls t
 
     let t ppf (x : t) = match x with
-      | Props pl -> props ppf pl
-      | Decls dl -> decls ppf dl
+      | Props pl -> prop_decls ppf pl
       | Exprs el -> exprs ppf el
 
   end
@@ -93,6 +81,46 @@ module Css = struct
     Output.t Format.str_formatter t;
     Format.flush_str_formatter ()
 
+  let is_prop = function
+    | Prop _ -> true
+    | _      -> false
+
+  let concat_paths p1 p2 = match p1, p2 with
+    | [], [] -> []
+    | [p],[]
+    | [],[p] -> [p]
+    | p1,p2  -> List.map (fun e1 -> List.flatten (List.map (fun e2 -> e1 @ e2) p1)) p2
+
+  let shift p = function
+    | [ Decl (path, body) ] -> Decl (concat_paths p path, body)
+    | props                 -> Decl (p, props)
+
+  (* split a root declaration body into a list of prop sequence or decl *)
+  let split ps =
+    let rec aux current accu = function
+    | []               -> List.rev (List.rev current :: accu)
+    | (Decl _ as d) :: t -> aux [] ([d] :: List.rev current :: accu) t
+    | (Prop _ as p) :: t -> aux (p :: current) accu t in
+    List.filter ((<>) []) (aux [] [] ps)
+
+  (* transform a fragment with nested declarations into
+     an equivalent fragment with only root declarations *)
+  let unroll t =
+    let rec aux accu = function
+      | Decl (a,b) ->
+        if List.for_all is_prop b then
+          (* no nested declarations *)
+          Decl (a, b) :: accu
+        else begin
+          (* split/shit/unroll the nested declarations *)
+          let splits = split b in
+          let shifts = List.map (shift a) splits in
+          List.fold_left aux accu shifts
+        end
+      | x -> x :: accu in
+    match t with
+      | Props pl -> Props (List.rev (List.fold_left aux [] pl))
+      | Exprs er -> assert false
 end
 
 (* From http://www.webdesignerwall.com/tutorials/cross-browser-css-gradient/ *)

lib/css.mli

@@ -22,16 +22,18 @@ type elt =
 (** Expression: `.body a:hover`. No commas here. *)
 and expr = elt list
 
-(** Property: `background-color: blue, red;` *)
-type prop = string * expr list
+(** We allow nested declarations *)
+type prop_decl =
 
-(** Declarations: `contents, header { color: white; }` *)
-type decl = expr list * prop list
+  (** Property: `background-color: blue, red;` *)
+  | Prop of string * expr list
+
+  (** Declarations: `contents, header { color: white; }` *)
+  | Decl of expr list * prop_decl list
 
 (** The type of CSS fragment *)
 type t =
-  | Props of prop list
-  | Decls of decl list
+  | Props of prop_decl list
   | Exprs of expr list
 
 val to_string : t -> string
@@ -40,10 +42,15 @@ val to_string : t -> string
 
 val expr : t -> expr
 val exprs : t -> expr list
-val decls : t -> decl list
-val props : t -> prop list
+val props : t -> prop_decl list
 val string : t -> string
 
+(** {3 Helpers} *)
+
+(** transform a fragment with nested declarations into
+    an equivalent fragment with only root declarations *)
+val unroll : t -> t
+
 (** {2 CSS library} *)
 
 val gradient : low:t -> high:t -> t

pa_lib/cass_ast.ml

@@ -43,11 +43,6 @@ let get_props _loc m =
     | <:expr< Css.Props $e$ >> -> <:expr< $e$ >>
     | m -> <:expr< Css.props $m$ >>
 
-let get_decls _loc m =
-  match m with
-    | <:expr< Css.Decls $e$ >> -> <:expr< $e$ >>
-    | m -> <:expr< Css.decls $m$ >>
-
 let get_string _loc m =
   match m with
     | <:expr< Css.Exprs [ [Css.Str $e$] ] >> -> <:expr< $e$ >>
@@ -60,12 +55,12 @@ let rec meta_t _loc = function
   | Decl (a,b) ->
     let elts  = get_exprs _loc (meta_t _loc a) in
     let props = get_props _loc (meta_t _loc b) in
-    <:expr< Css.Decls [ ($elts$, $props$) ] >>
+    <:expr< Css.Props [ Css.Decl ($elts$, $props$) ] >>
 
   | Rule (a,b) ->
     let name  = get_string _loc (meta_t _loc a) in
     let props = get_exprs _loc (meta_t _loc b) in
-    <:expr< Css.Props [ ($name$, $props$) ] >>
+    <:expr< Css.Props [ Css.Prop ($name$, $props$) ] >>
 
   | Fun (a,b) ->
     let name = get_string _loc (meta_t _loc a) in
@@ -92,3 +87,10 @@ let rec meta_t _loc = function
 
   | Ant (l, str) ->
     Ast.ExAnt (l, str)
+
+let meta_t _loc t =
+  let m = meta_t _loc t in
+  match m with
+    | <:expr< Css.Exprs $_$ >> -> m
+    | t -> <:expr< Css.unroll $m$ >>
+