Merge branch 'minimal'

Makefile

@@ -1,7 +1,7 @@
 RESULT    := mincss
 PRE_TGTS  := types
-MODULES   := color_names util stringify parser lexer parse selector color \
-             shorthand main
+MODULES   := color_names util stringify parser lexer parse selector simple \
+             shorthand duplicates main
 ALL_NAMES := $(PRE_TGTS) $(MODULES)
 
 OCAMLCFLAGS  := -g
@@ -36,10 +36,10 @@ 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 shorthand.cmx
+main.cmx: parse.cmx util.cmx simple.cmx shorthand.cmx duplicates.cmx
 util.cmx: OCAMLCFLAGS += -pp cpp
-util.cmx color.cmx: color_names.cmx
-stringify.cmx parser.cmx color.cmx shorthand.cmx: util.cmi
+util.cmx simple.cmx: color_names.cmx
+stringify.cmx parser.cmx simple.cmx shorthand.cmx: util.cmi
 $(addsuffix .cmx,$(MODULES)): $(addsuffix .cmi,$(PRE_TGTS))
 
 clean:

color_names.ml

@@ -3,14 +3,12 @@ open Types
 let compress = function
   | Ident "aliceblue"               -> Hexcolor "f0f8ff"
   | Ident "antiquewhite"            -> Hexcolor "faebd7"
-  | Ident "aqua"                    -> Hexcolor "0ff"
   | Ident "aquamarine"              -> Hexcolor "7fffd4"
   | Hexcolor "f0ffff"               -> Ident "azure"
   | Hexcolor "f5f5dc"               -> Ident "beige"
   | Hexcolor "ffe4c4"               -> Ident "bisque"
   | Ident "black"                   -> Hexcolor "000"
   | Ident "blanchedalmond"          -> Hexcolor "ffebcd"
-  | Ident "blue"                    -> Hexcolor "00f"
   | Ident "blueviolet"              -> Hexcolor "8a2be2"
   | Hexcolor "a52a2a"               -> Ident "brown"
   | Ident "burlywood"               -> Hexcolor "deb887"
@@ -20,7 +18,6 @@ let compress = function
   | Hexcolor "ff7f50"               -> Ident "coral"
   | Ident "cornflowerblue"          -> Hexcolor "6495ed"
   | Ident "cornsilk"                -> Hexcolor "fff8dc"
-  | Ident "cyan"                    -> Hexcolor "0ff"
   | Ident "darkblue"                -> Hexcolor "00008b"
   | Ident "darkcyan"                -> Hexcolor "008b8b"
   | Ident "darkgoldenrod"           -> Hexcolor "b8860b"
@@ -110,7 +107,6 @@ let compress = function
   | Hexcolor "dda0dd"               -> Ident "plum"
   | Ident "powderblue"              -> Hexcolor "b0e0e6"
   | Hexcolor "800080"               -> Ident "purple"
-  | Ident "red"                     -> Hexcolor "f00"
   | Ident "rosybrown"               -> Hexcolor "bc8f8f"
   | Ident "royalblue"               -> Hexcolor "4169e1"
   | Ident "saddlebrown"             -> Hexcolor "8b4513"

duplicates.ml

@@ -0,0 +1,37 @@
+open Types
+
+module SM =  Map.Make(String)
+
+let prune_duplicates decls =
+  let keep = Array.make (List.length decls) true in
+
+  let rec tag db index = function
+    | (name, _, imp) :: tl when SM.mem name db ->
+      (* previous value exists, one needs to be removed *)
+      let prev_index, prev_imp = SM.find name db in
+      if not imp && prev_imp then begin
+        keep.(index) <- false;
+        tag db (index + 1) tl
+      end else begin
+        keep.(prev_index) <- false;
+        tag (SM.add name (index, imp) db) (index + 1) tl
+      end
+    | (name, _, imp) :: tl ->
+      tag (SM.add name (index, imp) db) (index + 1) tl
+    | [] -> ()
+  in
+  tag SM.empty 0 decls;
+
+  let rec prune i = function
+    | []                     -> []
+    | hd :: tl when keep.(i) -> hd :: prune (i + 1) tl
+    | _ :: tl                -> prune (i + 1) tl
+  in
+  prune 0 decls
+
+let transform = function
+  | Statement (Ruleset (selectors, decls)) ->
+    Statement (Ruleset (selectors, prune_duplicates decls))
+  | v -> v
+
+let compress = Util.transform_stylesheet transform

main.ml

@@ -2,63 +2,114 @@ open Lexing
 open Types
 
 type args = {
-  mutable infiles : string list;
-  mutable outfile : string option;
-  mutable verbose : bool;
-  mutable prune   : bool;
-  mutable unfold  : bool;
-  mutable upto    : int option;
+  infiles    : string list;
+  outfile    : string option;
+  verbose    : bool;
+  whitespace : bool;
+  simple     : bool;
+  shorthands : bool;
+  duplicates : bool;
+  echo       : bool;
+  sort       : bool;
 }
 
-(* Parse command-line arguments *)
 let parse_args () =
-  let args = {
-    infiles = [];
-    outfile = None;
-    verbose = false;
-    prune = true;
-    unfold = true;
-    upto = None;
-  } in
+  let usage =
+    "Usage: " ^ Sys.argv.(0) ^
+    " [<options>] [<file> ...]\n\
+     \n\
+     Generic options:\n \
+     -h, --help        Show this help message\n \
+     -v, --verbose     Verbose mode: show compression rate\n \
+     -o <file>         Output file (defaults to stdout)\n \
+     <file> ...        Input files (default is to read from stdin)\n\
+     \n\
+     Optimization flags (if none are specified, all are enabled):\n \
+     -w, --whitespace  Eliminate unnecessary whitespaces (has the greatest \
+                       effect, omit for pretty-printing)\n \
+     -c, --simple      Shorten colors and font weights\n \
+     -s, --shorthands  Generate shorthand properties\n \
+     -d, --duplicates  Prune duplicate properties (WARNING: may affect \
+                       cross-browser hacks)\n \
+     -p, --pretty      Shorthand for -c -s -d\n \
+     -e, --echo        Just parse and pretty-print, no optimizations\n\
+     \n\
+     Formatting options:
+     --sort            Sort declarations in each selector group\n\
+     "
+  in
 
-  let args_spec = [
-    ("<file> ...", Arg.Rest (fun _ -> ()),
-                 "   Input files (default is to read from stdin)");
-
-    ("-o", Arg.String (fun s -> args.outfile <- Some s),
-         "<file>     Output file (defaults to stdout)");
-
-    ("-v", Arg.Unit (fun _ -> args.verbose <- true),
-         "           Verbose mode: show compression rate");
-
-    ("-no-prune", Arg.Unit (fun _ -> args.prune <- false),
-                "    Don't prune duplicate properties (skip step 5 below)");
-
-    ("-no-unfold", Arg.Unit (fun _ -> args.unfold <- false),
-                 "   Only minify whitespace, colors and shorthands \
-                     (skip steps 2-7 below)");
-
-    ("-upto", Arg.Int (fun i -> args.upto <- Some i),
-            "<step>  Stop after the specified step (for debugging): \
-                                              \n                \
-                     1: parse                 \n                \
-                     2: unfold shorthands     \n                \
-                     3: unfold selectors      \n                \
-                     4: unfold blocks         \n                \
-                     5: prune duplicates      \n                \
-                     6: combine selectors     \n                \
-                     7: concatenate blocks    \n                \
-                     8: optimize blocks       \n                \
-                     9: minify");
-  ] in
+  let default_args = {
+    infiles    = [];
+    outfile    = None;
+    verbose    = false;
+    whitespace = false;
+    simple     = false;
+    shorthands = false;
+    duplicates = false;
+    echo       = false;
+    sort       = false;
+  } in
 
-  let usage =
-    "Usage: " ^ Sys.argv.(0) ^ " [-o <file>] [-v] [-no-prune] [-upto <step>] \
-                                 [<file> ...] "
+  let rec handle args = function
+    | ("-v" | "--verbose") :: tl ->
+      handle {args with verbose = true} tl
+    | ("-w" | "--whitespace") :: tl ->
+      handle {args with whitespace = true} tl
+    | ("-c" | "--simple") :: tl ->
+      handle {args with simple = true} tl
+    | ("-s" | "--shorthands") :: tl ->
+      handle {args with shorthands = true} tl
+    | ("-d" | "-duplicates") :: tl ->
+      handle {args with duplicates = true} tl
+    | ("-p" | "--pretty") :: tl ->
+      handle {args with simple = true; shorthands = true; duplicates = true} tl
+    | ("-e" | "--echo") :: tl ->
+      handle {args with echo = true} tl
+    | "--sort" :: tl ->
+      handle {args with sort = true} tl
+
+    | ("-h" | "--help") :: tl ->
+      prerr_string usage;
+      raise Exit_success
+
+    | ["-o"] ->
+      raise (Failure ("missing output file name"))
+    | "-o" :: next :: tl when next.[0] = '-' ->
+      raise (Failure ("missing output file name"))
+    | "-o" :: filename :: tl ->
+      handle {args with outfile = Some filename} tl
+
+    | arg :: tl when arg.[0] = '-' ->
+      prerr_string usage;
+      raise (Failure ("unknown option " ^ arg))
+
+    | filename :: tl ->
+      handle {args with infiles = args.infiles @ [filename]} tl
+
+    | [] -> args
   in
 
-  Arg.parse args_spec (fun f -> args.infiles <- args.infiles @ [f]) usage;
-  args
+  match handle default_args (List.tl (Array.to_list Sys.argv)) with
+  | { echo = true; _ } as args ->
+    { args with
+      whitespace = false;
+      simple     = false;
+      shorthands = false;
+      duplicates = false }
+
+  | { whitespace = false;
+      simple     = false;
+      shorthands = false;
+      duplicates = false;
+      _ } as args ->
+    { args with
+      whitespace = true;
+      simple     = true;
+      shorthands = true;
+      duplicates = true }
+
+  | args -> args
 
 let parse_files = function
   | [] ->
@@ -68,6 +119,8 @@ let parse_files = function
     let rec loop = function
       | [] -> []
       | filename :: tl ->
+        if not (Sys.file_exists filename) then
+          raise (Failure ("file " ^ filename ^ " does not exist"));
         let input = Util.input_all (open_in filename) in
         let stylesheet = Parse.parse_input filename input in
         (input, stylesheet) :: loop tl
@@ -76,21 +129,6 @@ let parse_files = function
     (String.concat "" inputs, List.concat stylesheets)
 
 let handle_args args =
-  let steps =
-    (*let switch flag fn = if flag then fn else fun s -> s in*)
-    [
-      (*
-      switch args.unfold Unfold.unfold_shorthands;
-      switch args.unfold Unfold.unfold_selectors;
-      switch args.unfold Unfold.unfold_blocks;
-      switch (args.unfold && args.prune) Unfold.prune_duplicates;
-      switch args.unfold Combine.combine_selectors;
-      switch args.unfold Concat.concat_blocks;
-      Optimize.optimize_blocks;
-      *)
-    ]
-  in
-
   let write_output =
     match args.outfile with
     | None -> print_endline
@@ -98,31 +136,31 @@ let handle_args args =
       fun css -> let f = open_out name in output_string f css; close_out f
   in
 
-  let upto = match args.upto with Some i -> i | None -> 0 in
-
-  let input, stylesheet = parse_files args.infiles in
-
-  let rec do_steps i stylesheet = function
-    | _ when i = upto ->
-      write_output (Stringify.string_of_stylesheet stylesheet)
-
-    | [] ->
-      let output = Stringify.minify_stylesheet stylesheet in
-      write_output output;
-
-      if args.verbose then begin
-        let il = String.length input in
-        let ol = String.length output in
-        Printf.fprintf stderr "compression: %d -> %d bytes (%d%% of original)\n"
-        il ol (int_of_float (float_of_int ol /. float_of_int il *. 100.))
-      end
-
-    | step :: tl ->
-      do_steps (i + 1) (step stylesheet) tl
+  let switch flag fn = if flag then fn else fun x -> x in
+
+  let input, css = parse_files args.infiles in
+  let css = css
+    (* unfold before pruning duplicates so that shorthand components are
+     * correctly pruned *)
+    |> switch args.shorthands Shorthand.unfold_stylesheet
+    |> switch args.simple Simple.compress
+    |> switch args.duplicates Duplicates.compress
+    |> switch args.shorthands Shorthand.compress
+    |> switch args.sort Util.sort_stylesheet
   in
+  let output =
+    if args.whitespace
+      then Stringify.minify_stylesheet css
+      else Stringify.string_of_stylesheet css
+  in
+  write_output output;
 
-  do_steps 1 stylesheet steps
-
+  if args.verbose then begin
+    let il = String.length input in
+    let ol = String.length output in
+    Printf.fprintf stderr "compression: %d -> %d bytes (%d%% of original)\n"
+    il ol (int_of_float (float_of_int ol /. float_of_int il *. 100.))
+  end
 
 (* Main function, returns exit status *)
 let main () =
@@ -137,6 +175,8 @@ let main () =
       prerr_endline ("Error: " ^ msg ^ ": " ^ Stringify.string_of_box box);
     | Failure msg ->
       prerr_endline ("Error: " ^ msg);
+    | Exit_success ->
+      exit 0
   end;
   exit 1
 

shorthand.ml

@@ -10,7 +10,8 @@ let pattern = Str.regexp ("^\\(background\\|border\\|font\\|list-style" ^
                           "\\|outline\\|padding\\|margin\\)-\\(.*\\)$")
 
 let order = function
-  | "background" -> ["color"; "image"; "repeat"; "attachment"; "position"]
+  | "background" -> ["color"; "image"; "repeat"; "attachment"; "position-x";
+                     "position-y"]
   | "border"     -> ["width"; "style"; "color"]
   | "font"       -> ["style"; "variant"; "weight"; "size"; "family"]
   | "list-style" -> ["type"; "position"; "image"]
@@ -27,13 +28,17 @@ let rec decls_mem name = function
 (* find the value of the last declaration of some property (since the earlier
  * values are overridden), unless an earlier !important value was found *)
 let decls_find name decls =
-  let rec wrap known = function
-    | [] -> known
-    | (nm, value, true) :: _ when nm = name -> Some value
-    | (nm, value, false) :: tl when nm = name -> wrap (Some value) tl
-    | _ :: tl -> wrap known tl
+  let rec wrap known must_be_imp = function
+    | [] ->
+      known
+    | (nm, value, false) :: tl when nm = name && not must_be_imp ->
+      wrap (Some value) false tl
+    | (nm, value, true) :: tl when nm = name ->
+      wrap (Some value) true tl
+    | _ :: tl ->
+      wrap known must_be_imp tl
   in
-  match wrap None decls with
+  match wrap None false decls with
   | None -> raise Not_found
   | Some value -> value
 
@@ -232,7 +237,8 @@ let rec unfold = function
 let make_shorthands decls =
   (* unfold currently existing shorthands into separate properties for merging
    * with override properties that are defined later on *)
-  let decls = unfold decls in
+  (*let decls = unfold decls in
+    XXX: done by main function for correct pruning of duplicate declarations*)
 
   (* find shorthand names for which properties are present *)
   let rec find_props = function
@@ -259,7 +265,8 @@ let make_shorthands decls =
   let keep_prop = function
     | ("line-height", _, _) ->
       not (decls_mem "font" shorthands)
-    | (name, _, _) ->
+    | (name, _, imp) ->
+      imp ||
       not (Str.string_match pattern name 0) ||
       let base = Str.matched_group 1 name in
       let sub = Str.matched_group 2 name in

color.ml → simple.ml

@@ -12,7 +12,7 @@ let clip = function
   | Number (n, Some "%") when n > 100. -> Number (100., Some "%")
   | value -> value
 
-let rec short = function
+let rec shorten_expr = function
   (* #aabbcc -> #abc *)
   | Hexcolor h when Str.string_match hex6 h 0 ->
     let gr n = Str.matched_group n h in
@@ -27,7 +27,7 @@ let rec short = function
       | Number (n, Some "%") -> int_of_float (n *. 2.55 +. 0.5)
       | _ -> assert false
     in
-    short (Hexcolor (Printf.sprintf "%02x%02x%02x" (i r) (i g) (i b)))
+    shorten_expr (Hexcolor (Printf.sprintf "%02x%02x%02x" (i r) (i g) (i b)))
 
   (* clip rgb values, e.g. rgb(-1,256,0) -> rgb(0,255,0) *)
   | Function ("rgb", Nary (",", [r; g; b])) ->
@@ -35,15 +35,22 @@ let rec short = function
 
   (* rgba(r,g,b,1.0) -> rgb(r,g,b) *)
   | Function ("rgba", Nary (",", [r; g; b; Number (1., None)])) ->
-    short (Function ("rgb", Nary (",", [r; g; b])))
+    shorten_expr (Function ("rgb", Nary (",", [r; g; b])))
 
   (* TODO: hsl[a](...) *)
 
   (* transform color names to shorter hex codes and vice-versa *)
   | v -> Color_names.compress v
 
+let shorten_font_weight = function
+  | Ident "normal" -> Number (400.0, None)
+  | Ident "bold"   -> Number (700.0, None)
+  | v -> v
+
 let transform = function
-  | Expr value -> Expr (short value)
+  | Expr value -> Expr (shorten_expr value)
+  | Declaration ("font-weight", value, imp) ->
+    Declaration ("font-weight", shorten_font_weight value, imp)
   | v -> v
 
 let compress = Util.transform_stylesheet transform

types.ml

@@ -86,3 +86,5 @@ exception Syntax_error of string
 exception Loc_error of loc * string
 
 exception Box_error of box * string
+
+exception Exit_success

util.ml

@@ -231,3 +231,19 @@ let transform_stylesheet f stylesheet =
 (* Expression identification *)
 
 let is_color = Color_names.is_color
+
+(* Sorting declarations *)
+
+let sort_stylesheet =
+  let transform_sort_decls = function
+    | Statement (Ruleset (selectors, decls)) ->
+      let pattern = Str.regexp "^\\([^-]+\\)-" in
+      let stem x =
+        if Str.string_match pattern x 0 then Str.matched_group 1 x else x
+      in
+      let cmp (a, _, _) (b, _, _) = String.compare (stem a) (stem b) in
+      Statement (Ruleset (selectors, List.stable_sort cmp decls))
+    | v -> v
+  in
+  transform_stylesheet transform_sort_decls
+