diff --git a/Makefile b/Makefile index 504fdef8e6ee5827038d126cb18a76cccba4e482..e518cef44ea27e1bdf471c9963cf21d390dbaf92 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ RESULT := mincss PRE_TGTS := types -MODULES := util stringify parser lexer parse color main +MODULES := util stringify parser lexer parse color shorthand main ALL_NAMES := $(PRE_TGTS) $(MODULES) OCAMLCFLAGS := -g @@ -35,8 +35,9 @@ lexer.cmi: lexer.ml parser.cmx: parser.cmi lexer.cmx parser.mli: parser.ml parse.cmx: lexer.cmi parser.cmx -main.cmx: parse.cmx util.cmx color.cmx +main.cmx: parse.cmx util.cmx color.cmx shorthand.cmx util.cmx: OCAMLCFLAGS += -pp cpp +stringify.cmx parser.cmx color.cmx shorthand.cmx: util.cmi $(addsuffix .cmx,$(MODULES)): $(addsuffix .cmi,$(PRE_TGTS)) clean: diff --git a/main.ml b/main.ml index bf0c7f16dbfce0a3903c2aafd88678237c48ac1c..7138771d18ea8ad51e4a2f138914618bdda99b1c 100644 --- a/main.ml +++ b/main.ml @@ -6,6 +6,7 @@ type args = { mutable outfile : string option; mutable verbose : int; mutable echo : bool; + mutable pretty : bool; } (* Parse command-line arguments *) @@ -15,6 +16,7 @@ let parse_args () = outfile = None; verbose = 1; echo = false; + pretty = false; } in let args_spec = [ ("<file> ...", Arg.Rest (fun _ -> ()), @@ -29,10 +31,14 @@ let parse_args () = ("--echo", Arg.Unit (fun _ -> args.echo <- true), " Don't minify, just pretty-print the parsed CSS"); + + ("--pretty", Arg.Unit (fun _ -> args.pretty <- true), + " Minify, but pretty-print the parsed CSS (for debugging)"); ] in let usage = - "Usage: " ^ Sys.argv.(0) ^ " [-o <file>] [-v <verbosity>] [<file> ...]" + "Usage: " ^ Sys.argv.(0) ^ " [-o <file>] [-v <verbosity>] [<file> ...] " ^ + "[--pretty | --echo]" in Arg.parse args_spec (fun f -> args.infiles <- args.infiles @ [f]) usage; @@ -68,8 +74,17 @@ let handle_args args = write_output (Stringify.string_of_stylesheet stylesheet) | _ -> let stylesheet = Color.compress stylesheet in - let output = Stringify.minify_stylesheet stylesheet in + let stylesheet = Shorthand.compress stylesheet in + + let stringify = + if args.pretty + then Stringify.string_of_stylesheet + else Stringify.minify_stylesheet + in + let output = stringify stylesheet in + write_output output; + if args.verbose >= 2 then begin let il = String.length input in let ol = String.length output in diff --git a/shorthand.ml b/shorthand.ml new file mode 100644 index 0000000000000000000000000000000000000000..13bed311a2d77381df34e95fc848068534d16ca6 --- /dev/null +++ b/shorthand.ml @@ -0,0 +1,100 @@ +(* CSS shorthand creation based on: + * - http://www.cssshorthand.com/ + *) + +open Types +open Util +module SS = Set.Make(String) + +let pattern = Str.regexp ("^\\(background\\|border\\|font\\|list-style" ^ + "\\|outline\\|padding\\|margin\\)-\\(.*\\)$") + +let subprops = function + | "background" -> ["color"; "image"; "repeat"; "attachment"; "position"] + | "border" -> ["width"; "style"; "color"] + | "font" -> ["style"; "variant"; "weight"; "size"; "family"] + | "list-style" -> ["type"; "position"; "image"] + | "outline" -> ["color"; "style"; "width"] + | "margin" | "padding" -> ["top"; "right"; "bottom"; "left"] + | _ -> failwith "not a shorthand property" + +let rec decls_mem name = function + | [] -> false + | (nm, _, false) :: _ when nm = name -> true + | _ :: tl -> decls_mem name tl + +let rec prop_value name = function + | [] -> raise Not_found + | (nm, value, false) :: _ when nm = name -> value + | _ :: tl -> prop_value name tl + +let order base decls = + let rec filter = function + | [] -> [] + | "size" :: tl when base = "font" && decls_mem "line-height" decls -> + let font_size = prop_value "font-size" decls in + let line_height = prop_value "line-height" decls in + Nary ("/", [font_size; line_height]) :: filter tl + | name :: tl when decls_mem (base ^ "-" ^ name) decls -> + prop_value (base ^ "-" ^ name) decls :: filter tl + | _ :: tl -> filter tl + in + filter (subprops base) + +let rec shorten decls = function + | "font" when not (decls_mem "font-size" decls) -> + shorten (("font-size", Ident "medium", false) :: decls) "font" + | "font" when decls_mem "font-family" decls -> + Some (Concat (order "font" decls)) + | "border" when decls_mem "border-style" decls -> + Some (Concat (order "border" decls)) + | ("background" | "list-style" | "outline") as base -> + Some (Concat (order base decls)) + | ("margin" | "padding") as base when + let has dir = decls_mem (base ^ "-" ^ dir) decls in + has "top" && has "right" && has "bottom" && has "left" -> + let get dir = prop_value (base ^ "-" ^ dir) decls in + Some (Concat [get "top"; get "right"; get "bottom"; get "left"]) + | _ -> None + +let make_shorthands decls = + (* find basenames for which properties are present *) + let rec find_props = function + | [] -> SS.empty + | (name, value, false) :: tl when Str.string_match pattern name 0 -> + let base = Str.matched_group 1 name in + let sub = Str.matched_group 2 name in + if List.mem sub (subprops base) + then SS.add base (find_props tl) + else find_props tl + | _ :: tl -> find_props tl + in + let try_shorthands = find_props decls in + + (* try to generate shorthands for the matched base properties *) + let rec replace base tl = + match shorten decls base with + | None -> tl + | Some short_value -> (base, short_value, false) :: tl + in + let shorthands = SS.fold replace try_shorthands [] in + + (* filter out the original, partial properties, and prepend the shorthands *) + let keep_prop = function + | (_, _, true) -> true + | ("line-height", _, false) -> + not (decls_mem "font" shorthands) + | (name, _, false) -> + not (Str.string_match pattern name 0) || + let base = Str.matched_group 1 name in + let sub = Str.matched_group 2 name in + not (List.mem sub (subprops base)) || not (decls_mem base shorthands) + in + shorthands @ List.filter keep_prop decls + +let transform = function + | Statement (Ruleset (selectors, decls)) -> + Statement (Ruleset (selectors, make_shorthands decls)) + | v -> v + +let compress = Util.transform_stylesheet transform diff --git a/util.ml b/util.ml index ca8d168758c4cc1dad8becb29a6a37b69ef2260c..34f7fe84a2466d9b0dcaff83a3a311248568e6ba 100644 --- a/util.ml +++ b/util.ml @@ -7,6 +7,10 @@ let (|>) a b = b a (** List utilities *) +let is_none = function None -> true | Some _ -> false +let is_some = function None -> false | Some _ -> true +let some_val = function None -> failwith "no value" | Some v -> v + let rec filter_none = function | [] -> [] | None :: tl -> filter_none tl