main.ml 4.92 KB
Newer Older
1 2 3
open Lexing
open Types

4
type args = {
5 6 7 8
  infiles    : string list;
  outfile    : string option;
  verbose    : bool;
  whitespace : bool;
9
  simple     : bool;
10 11 12
  shorthands : bool;
  duplicates : bool;
  echo       : bool;
13 14
}

15
let parse_args () =
16 17 18 19 20 21 22 23 24 25 26 27 28
  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 \
29
     -c, --simple      Shorten colors and font weights\n \
30 31 32
     -s, --shorthands  Generate shorthand properties\n \
     -d, --duplicates  Prune duplicate properties (WARNING: may affect \
                       cross-browser hacks)\n \
33
     -p, --pretty      Shorthand for -c -s -d\n \
34 35
     -e, --echo        Just parse and pretty-print, no optimizations\n"
  in
36

37 38 39 40 41
  let default_args = {
    infiles    = [];
    outfile    = None;
    verbose    = false;
    whitespace = false;
42
    simple     = false;
43 44 45 46
    shorthands = false;
    duplicates = false;
    echo       = false;
  } in
47

48 49 50 51 52
  let rec handle args = function
    | ("-v" | "--verbose") :: tl ->
      handle {args with verbose = true} tl
    | ("-w" | "--whitespace") :: tl ->
      handle {args with whitespace = true} tl
53 54
    | ("-c" | "--simple") :: tl ->
      handle {args with simple = true} tl
55 56 57 58 59
    | ("-s" | "--shorthands") :: tl ->
      handle {args with shorthands = true} tl
    | ("-d" | "-duplicates") :: tl ->
      handle {args with duplicates = true} tl
    | ("-p" | "--pretty") :: tl ->
60
      handle {args with simple = true; shorthands = true; duplicates = true} tl
61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
    | ("-e" | "--echo") :: tl ->
      handle {args with echo = 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
83 84
  in

85 86
  match handle default_args (List.tl (Array.to_list Sys.argv)) with
  | { whitespace = false;
87
      simple     = false;
88 89 90 91 92 93
      shorthands = false;
      duplicates = false;
      echo       = false;
      _ } as args ->
    { args with
      whitespace = true;
94
      simple     = true;
95 96 97
      shorthands = true;
      duplicates = true }
  | args -> args
98

99 100 101 102 103 104 105 106
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 ->
107 108
        if not (Sys.file_exists filename) then
          raise (Failure ("file " ^ filename ^ " does not exist"));
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123
        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 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

124
  let switch flag fn = if flag then fn else fun x -> x in
125

126 127
  let input, css = parse_files args.infiles in
  let css = css
128 129 130
    (* unfold before pruning duplicates so that shorthand components are
     * correctly pruned *)
    |> switch args.shorthands Shorthand.unfold_stylesheet
131
    |> switch args.simple Simple.compress
132
    |> switch args.duplicates Duplicates.compress
133
    |> switch args.shorthands Shorthand.compress
134
  in
135 136 137 138 139 140
  let output =
    if args.whitespace
      then Stringify.minify_stylesheet css
      else Stringify.string_of_stylesheet css
  in
  write_output output;
141

142 143 144 145 146 147
  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
148 149

(* Main function, returns exit status *)
150
let main () =
151 152
  begin
    try
153
      handle_args (parse_args ());
154 155
      exit 0
    with
156
    | Loc_error (loc, msg) ->
157
      Util.prerr_loc_msg loc ("Error: " ^ msg);
158 159 160 161
    | Box_error (box, msg) ->
      prerr_endline ("Error: " ^ msg ^ ": " ^ Stringify.string_of_box box);
    | Failure msg ->
      prerr_endline ("Error: " ^ msg);
162 163
    | Exit_success ->
      exit 0
164
  end;
165
  exit 1
166

167
let _ = main ()