Skip to content
Snippets Groups Projects
Commit 68e19c17 authored by Taddeüs Kroes's avatar Taddeüs Kroes
Browse files

Implemented shorthand compression

parent edae5198
No related branches found
No related tags found
No related merge requests found
RESULT := mincss RESULT := mincss
PRE_TGTS := types 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) ALL_NAMES := $(PRE_TGTS) $(MODULES)
OCAMLCFLAGS := -g OCAMLCFLAGS := -g
...@@ -35,8 +35,9 @@ lexer.cmi: lexer.ml ...@@ -35,8 +35,9 @@ lexer.cmi: lexer.ml
parser.cmx: parser.cmi lexer.cmx parser.cmx: parser.cmi lexer.cmx
parser.mli: parser.ml parser.mli: parser.ml
parse.cmx: lexer.cmi parser.cmx 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 util.cmx: OCAMLCFLAGS += -pp cpp
stringify.cmx parser.cmx color.cmx shorthand.cmx: util.cmi
$(addsuffix .cmx,$(MODULES)): $(addsuffix .cmi,$(PRE_TGTS)) $(addsuffix .cmx,$(MODULES)): $(addsuffix .cmi,$(PRE_TGTS))
clean: clean:
......
...@@ -6,6 +6,7 @@ type args = { ...@@ -6,6 +6,7 @@ type args = {
mutable outfile : string option; mutable outfile : string option;
mutable verbose : int; mutable verbose : int;
mutable echo : bool; mutable echo : bool;
mutable pretty : bool;
} }
(* Parse command-line arguments *) (* Parse command-line arguments *)
...@@ -15,6 +16,7 @@ let parse_args () = ...@@ -15,6 +16,7 @@ let parse_args () =
outfile = None; outfile = None;
verbose = 1; verbose = 1;
echo = false; echo = false;
pretty = false;
} in } in
let args_spec = [ let args_spec = [
("<file> ...", Arg.Rest (fun _ -> ()), ("<file> ...", Arg.Rest (fun _ -> ()),
...@@ -29,10 +31,14 @@ let parse_args () = ...@@ -29,10 +31,14 @@ let parse_args () =
("--echo", Arg.Unit (fun _ -> args.echo <- true), ("--echo", Arg.Unit (fun _ -> args.echo <- true),
" Don't minify, just pretty-print the parsed CSS"); " 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 ] in
let usage = let usage =
"Usage: " ^ Sys.argv.(0) ^ " [-o <file>] [-v <verbosity>] [<file> ...]" "Usage: " ^ Sys.argv.(0) ^ " [-o <file>] [-v <verbosity>] [<file> ...] " ^
"[--pretty | --echo]"
in in
Arg.parse args_spec (fun f -> args.infiles <- args.infiles @ [f]) usage; Arg.parse args_spec (fun f -> args.infiles <- args.infiles @ [f]) usage;
...@@ -68,8 +74,17 @@ let handle_args args = ...@@ -68,8 +74,17 @@ let handle_args args =
write_output (Stringify.string_of_stylesheet stylesheet) write_output (Stringify.string_of_stylesheet stylesheet)
| _ -> | _ ->
let stylesheet = Color.compress stylesheet in 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; write_output output;
if args.verbose >= 2 then begin if args.verbose >= 2 then begin
let il = String.length input in let il = String.length input in
let ol = String.length output 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 ...@@ -7,6 +7,10 @@ let (|>) a b = b a
(** List utilities *) (** 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 let rec filter_none = function
| [] -> [] | [] -> []
| None :: tl -> filter_none tl | None :: tl -> filter_none tl
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment