Commit 68e19c17 authored by Taddeüs Kroes's avatar Taddeüs Kroes

Implemented shorthand compression

parent edae5198
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:
......
......@@ -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
......
(* 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
......@@ -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
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment