Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

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

  • Loading branch information...
commit 26f207b9adcc97830138a364189552a2b182f6ae 1 parent 1e8be83
@samoht authored
Showing with 75 additions and 37 deletions.
  1. +1 −0  _tags
  2. +50 −22 lib/css.ml
  3. +15 −8 lib/css.mli
  4. +9 −7 pa_lib/cass_ast.ml
View
1  _tags
@@ -1 +1,2 @@
+true: debug
<pa_lib> or <lib> or <lib_test>: include
View
72 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/ *)
View
23 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
View
16 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$ >>
+
Please sign in to comment.
Something went wrong with that request. Please try again.