Rewrote main function, added some command-line arguments

main.ml

 open Lexing
 open Types
 
+type args = {
+  mutable infiles : string list;
+  mutable outfile : string option;
+  mutable verbose : int;
+  mutable echo : bool;
+  mutable keep_comments : bool;
+}
+
 (* Parse command-line arguments *)
 let parse_args () =
   let args = {
     infiles = [];
     outfile = None;
     verbose = 1;
+    echo = false;
+    keep_comments = false;
   } in
   let args_spec = [
     ("<file> ...", Arg.Rest (fun _ -> ()),
@@ -18,6 +28,12 @@ let parse_args () =
     ("-v", Arg.Int (fun i -> args.verbose <- i),
          "<num>    Set verbosity (0: nothing, 1: errors (default), \
           2: compression rate, 3: debug)");
+
+    ("--echo", Arg.Unit (fun _ -> args.echo <- true),
+             "     Don't minify, just pretty-print the parsed CSS");
+
+    ("--keep-comments", Arg.Unit (fun _ -> args.keep_comments <- true),
+  "\n              Preserve top-level comments");
   ] in
 
   let usage =
@@ -27,35 +43,57 @@ let parse_args () =
   Arg.parse args_spec (fun f -> args.infiles <- args.infiles @ [f]) usage;
   args
 
-(* Main function, returns exit status
- * Command-line arguments are stored in lobals.args *)
+let parse_files = function
+  | [] ->
+    let input = Util.input_buffered stdin 512 in
+    (input, Parse.parse_input "<stdin>" input)
+  | files ->
+    let rec loop = function
+      | [] -> []
+      | filename :: tl ->
+        let input = Util.input_all (open_in filename) in
+        let stylesheet = Parse.parse_input filename input in
+        (input, stylesheet) :: loop tl
+    in
+    let inputs, stylesheets = List.split (loop files) in
+    (String.concat "" inputs, List.concat stylesheets)
+
+let handle_args args =
+  let input, stylesheet = parse_files args.infiles in
+
+  let write_output =
+    match args.outfile with
+    | None -> print_endline
+    | Some name ->
+      fun css -> let f = open_out name in output_string f css; close_out f
+  in
+
+  match args with
+  | {echo = true} ->
+    write_output (Stringify.string_of_stylesheet stylesheet)
+  | _ ->
+    let output = Stringify.minify_stylesheet stylesheet in
+    write_output output;
+    if args.verbose >= 2 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 () =
   let args = parse_args () in
-  try
-    let stylesheet =
-      match args.infiles with
-      | [] ->
-        let input = Util.input_buffered stdin 512 in
-        Parse.parse_input "<stdin>" input
-      | files ->
-        let rec loop = function
-          | [] -> []
-          | filename :: tl ->
-            let input = Util.input_all (open_in filename) in
-            let stylesheet = Parse.parse_input filename input in
-            stylesheet @ loop tl
-        in
-        loop files
-    in
-    print_endline (Stringify.string_of_stylesheet stylesheet);
-    print_endline "\n";
-    print_endline (Stringify.minify_stylesheet stylesheet);
-    exit 0
-  with
-  | LocError (loc, msg) ->
-    Util.prerr_loc_msg args loc ("Error: " ^ msg);
-  | Failure err ->
-    prerr_endline ("Error: " ^ err);
+  begin
+    try
+      handle_args args;
+      exit 0
+    with
+    | LocError (loc, msg) ->
+      Util.prerr_loc_msg (args.verbose >= 1) loc ("Error: " ^ msg);
+    | Failure err ->
+      prerr_endline ("Error: " ^ err);
+  end;
   exit 1
 
 let _ = main ()

types.ml

@@ -53,12 +53,6 @@ type statement =
 
 type stylesheet = statement list
 
-type args = {
-  mutable infiles : string list;
-  mutable outfile : string option;
-  mutable verbose : int;
-}
-
 type loc = string * int * int * int * int
 
 exception SyntaxError of string

util.ml

@@ -36,7 +36,8 @@ let count_tabs str upto =
   let rec count n = function
     | 0 -> n
     | i -> count (if String.get str (i - 1) = '\t' then n + 1 else n) (i - 1)
-  in count 0 upto
+  in
+  count 0 upto
 
 let rec repeat s n = if n < 1 then "" else s ^ (repeat s (n - 1))
 
@@ -48,7 +49,7 @@ let prerr_loc (fname, ystart, yend, xstart, xend) =
   let file = open_in fname in
 
   (* skip lines until the first matched line *)
-  for i = 1 to ystart - 1 do let _ = input_line file in () done;
+  for i = 1 to ystart - 1 do ignore (input_line file) done;
 
   (* for each line in `loc`, print the source line with an underline *)
   for l = ystart to yend do
@@ -63,11 +64,10 @@ let prerr_loc (fname, ystart, yend, xstart, xend) =
       for i = left to right do prerr_char '^' done;
       prerr_endline "";
     end
-  done;
-  ()
+  done
 
-let prerr_loc_msg args loc msg =
-  if args.verbose >= 1 then begin
+let prerr_loc_msg verbose loc msg =
+  if verbose then begin
     let (fname, ystart, yend, xstart, xend) = loc in
     if loc != noloc then begin
       let line_s = if yend != ystart
@@ -82,8 +82,7 @@ let prerr_loc_msg args loc msg =
     end;
     eprintf "%s\n" msg;
 
-    if args.verbose >= 1 && loc != noloc then
+    if verbose && loc != noloc then
         try prerr_loc loc
         with Sys_error _ -> ()
-  end;
-  ()
+  end