car

#!/usr/bin/env ocaml
#load "unix.cma"
#load "str.cma"
(* car: A collection of aliases for common tasks on OCaml projects using ocamlbuild.
   (cons was taken!)

   Packaged in one script for ease of distributing modified versions for
   specific projects.

   Licensed under the BSD 2-Clause License.
   Copyright 2015 Jonathan Y. Chan <jyc@fastmail.fm>
   https://github.com/jonathanyc/car *)

open Unix
open Printf
(* Make sure we are using Pervasive's stderr, etc. *)
open Pervasives

(* Constants. *)
let src_dir = "src"
let config_path = "_car"

type rule_group =
  | Build
  | Test
  | Run

  | Destroy
  | Splice
  | Install

  | Print

(** [scary_groups] is a list of rule groups that shouldn't be run without being
    explicitly specified, e.g. clean, lib. [rule_all] does not run them. *)
let scary_groups = [Destroy; Splice; Install; Print; Run]

(** [config] represents the configuration for a project using car, stored in
    TOML file at [config_path] (except for [args], which comes from the
    command-line arguments.).

    Note: if this format changes, make sure to modify [init] accordingly! *)
type config = {
  project : string;
  package : string;
  requires : string list;
  flags : string list;

  args : string list;
  run_args : string list;
}

let (@.) f g x = f (g x)

(** [is_scary group] returns [true] if a group is scary.
    @see [scary_groups] *)
let is_scary group = List.mem group scary_groups

(** [error s] prints [s] colored red to stderr before exiting the program. *)
let error s =
  fprintf stderr "\x1b[31m%s\x1b[0m" s ;
  prerr_endline "" ;
  exit 1

(* Can't seem to abstract these functions without confusing the compiler / type
   system about which strings are supposed to be format strings. *)

(** [action verb format args*] prints [verb] colored green followed by [printf
    format args*]. It is used to display big actions. *)
let action verb =
  ksprintf
    (fun s ->
       printf "\x1b[32m%s\x1b[0m" verb ;
       print_endline (" " ^ s) ;
       flush stdout)

(** [scary verb format args*] prints [verb] colored yellow followed by [printf
    format args*]. It is used to display big actions that might have
    unusually destructive effects. *)
let scary verb = 
  ksprintf
    (fun s ->
       printf "\x1b[33m%s\x1b[0m" verb ;
       print_endline (" " ^ s) ;
       flush stdout)

(** [note verb format args*] prints [verb] colored blue followed by [printf
    format args*]. It is used to display notes about smaller actions. *)
let note verb =
  ksprintf
    (fun s ->
       printf "\x1b[34m%s\x1b[0m" verb ;
       print_endline (" " ^ s) ;
       flush stdout)

(* Config parsing. *)

type carn = [
    `String of string
  | `List of carn list
]

let read_chars path = 
  let inch = open_in path in
  let rec loop chars =
    match input_char inch with
    | c -> loop (c :: chars)
    | exception End_of_file -> List.rev chars
  in
  let res = loop [] in
  close_in inch ;
  res

(* project = "indoor-wiki"
   ^ start
            ^ end
   Spaces ignored.
*)
let parse_key chars =
  let buf = Buffer.create 0 in
  let rec loop = function
    | ('a'..'z' | 'A'..'Z' as c) :: cs ->
      Buffer.add_char buf c ;
      loop cs
    | ' ' :: cs -> loop cs
    | '=' :: cs ->
      if Buffer.length buf = 0 then `Fail (0, "Empty key.")
      else `Ok (0, `Key (Buffer.contents buf), cs)
    | [] -> `Fail (0, "Unexpected EOF.")
    | c :: _ -> `Fail (0, sprintf "Invalid character in key: %C." c)
  in loop chars

(* project = "indoor-wiki"
              ^ start
                          ^ end
*)
let parse_string chars =
  let buf = Buffer.create 0 in
  let rec loop i esc = function
    | '\n' :: cs ->
      if not esc then Buffer.add_char buf '\n' ;
      loop (i + 1) false cs
    | c :: cs when esc ->
      Buffer.add_char buf c ;
      loop i false cs
    | '\\' :: cs -> loop i true cs
    | '"' :: cs -> `Ok (i, `String (Buffer.contents buf), cs)
    | c :: cs ->
      Buffer.add_char buf c ;
      loop i false cs
    | [] -> `Fail (i, "Unexpected EOF.")
  in loop 0 false chars

(* requires = [
               ^
       ...
   ]
    ^
*)
let rec parse_list chars =
  let rec loop i entries = function
    | ' ' :: cs -> loop i entries cs
    | '\n' :: cs -> loop (i + 1) entries cs
    | ']' :: cs -> `Ok (i, `List (List.rev entries), cs)
    | '#' :: cs -> 
      let rec eat = function
        | '\n' :: cs -> loop (i + 1) entries cs
        | _ :: cs -> eat cs
        | [] -> `Fail (i, "Unexpected EOF.")
      in eat cs
    | _ :: _ as cs ->
      begin match parse_value cs with
      | `Fail (j, s) -> `Fail (i + j, s)
      | `Ok (j, x, cs) ->
        begin match cs with
        | (',' :: cs) | (_ :: _ as cs) ->
          loop (i + j) (x :: entries) cs
        | [] -> `Fail (i + j, "Unexpected EOF.")
        end
      end
    | [] -> `Fail (i, "Unexpected EOF.")
  in loop 0 [] chars

(* project = "indoor-wiki"
            ^ start       ^ end
   Spaces ignored.
*)
and parse_value = function
  | ' ' :: cs -> parse_value cs
  | '"' :: cs -> parse_string cs
  | '[' :: cs -> parse_list cs
  | c :: _ -> `Fail (0, sprintf "Unexpected value starting with %C." c)
  | [] -> `Fail (0, "Unexpected EOF.")

let parse_carfile path =
  let chars = read_chars path in
  let rec loop i kvs chars =
    match chars with
    | ('a'..'z' | 'A'..'Z') :: _ as cs ->
      begin match parse_key cs with
      | `Ok (j0, `Key s, cs) ->
        begin match parse_value cs with
        | `Ok (j1, v, cs) ->
          loop (i + j0 + j1) ((s, v) :: kvs) cs
        | `Fail (j1, s) -> `Error (sprintf "%s:%d: %s" path (i + j0 + j1) s)
        end
      | `Fail (j0, s) -> `Error (sprintf "%s:%d: %s" path (i + j0) s)
      end
    | '#' :: cs ->
      let rec eat = function
        | '\n' :: cs -> loop (i + 1) kvs cs
        | _ :: cs -> eat cs
        | [] -> `Ok (List.rev kvs)
      in eat cs
    | ' ' :: cs -> loop i kvs cs
    | '\n' :: cs -> loop (i + 1) kvs cs
    | c :: cs -> `Error (sprintf "%s:%d: Unexpected character %C." path i c)
    | [] -> `Ok (List.rev kvs)
  in loop 1 [] chars

let carn_string carn key =
  match List.assoc key carn with
  | `String s -> Some s
  | _ -> None
  | exception Not_found -> None

let carn_strings carn key =
  match List.assoc key carn with
  | `List xs ->
    if List.exists (function `String _ -> false | _ -> true) xs then None
    else Some (List.map (function `String s -> s | _ -> assert false) xs)
  | _ -> None
  | exception Not_found -> None

(** [load_config ()] tries to load a [config] from a carfile at
    [config_path]. If it fails it errors and exits the program. *)
let load_config () =
  try
    if not (Sys.file_exists config_path) then
      failwith @@ sprintf "No file found at %s." config_path ;
    let data =
      match parse_carfile config_path with
      | `Ok x -> x
      | `Error s -> failwith s
    in
    let required (name, x) =
      match x with
      | None -> failwith @@ sprintf "Couldn't find key '%s'." name
      | Some y -> y
    in
    let optional ~default (name, x) =
      match x with
      | None -> default
      | Some y -> y
    in
    let load f name = name, f data name in
    let load_string = load carn_string in
    let load_strings = load carn_strings in
    { project = required @@ load_string "project";
      package = required @@ load_string "package";
      requires = required @@ load_strings "requires";
      flags = optional ~default:[] @@ load_strings "flags";
      args = [];
      run_args = [] }
  with e ->
      error @@ sprintf "Error while loading configuration: %s" (Printexc.to_string e)

(** If [log_commands] is [true], we print out the commands we are exiting
    through [run] and [run_status] before executing them. It can be toggled
    directly or around a block of code using [with_log_commands]. *)
let log_commands = ref true

(** [with_log_commands x f] sets [log_commands] to [x] before calling [f ()].
    After that call returns it sets [log_commands] to what it was previously. *)
let with_log_commands x f =
  let prev = !log_commands in
  log_commands := x ;
  f () ;
  log_commands := prev

(** [run cmd] runs the command [cmd] using [system] (i.e. it is interpreted
    using /bin/sh). If [log_commands] is [true], the command is output before
    it is run. If the command returns a non-zero exit code or is killed by /
    exits due to a signal, we print an error is printed to stderr and [exit 1]. *)
let run cmd =
  if !log_commands then
    print_endline cmd
  else () ;
  match system cmd with
  | WEXITED 0 -> ()
  | WEXITED x ->
    error @@ sprintf "Command failed: '%s' exited with code %d." cmd x
  | _ ->
    error @@ sprintf "Command failed: '%s' exited abnormally." cmd

(** [run_status cmd] is ike [run cmd] except it returns the exit code of the
    command. Unlike [run cmd] it only prints an error and exits when the
    process is terminated unusually -- non-zero exit codes are simply returned. *)
let run_status cmd =
  if !log_commands then
    print_endline cmd
  else () ;
  match system cmd with
  | WEXITED code -> code
  | _ ->
    error @@ sprintf "Command failed: '%s' exited abnormally." cmd

(* TODO: document. *)
let run' ?(env=[]) ?(args=[]) cmd =
  if !log_commands then
    print_endline cmd ;

  let args' = Array.of_list (cmd :: args) in
  let env' =
    Array.append
      (Array.of_list env)
      (Unix.environment ())
  in

  let pid = Unix.fork () in

  if pid = 0 then begin
    (* We're the child. *)
    Unix.execvpe cmd args' env'
  end ;

  match Unix.waitpid [] pid with
  | _, WEXITED 0 -> ()
  | _, WEXITED x ->
    error @@ sprintf "Command failed: '%s' exited with code %d." cmd x
  | _ ->
    error @@ sprintf "Command failed: '%s' exited abnormally." cmd

(** [has_package name] returns [true] if the package [name] is known to
    ocamlfind. *)
let has_package name =
  run_status (sprintf "ocamlfind query %s >/dev/null 2>&1" name) = 0

(** [ocb ?flags ?quiet cmd] runs the ocamlfind command [cmd]. If [quiet] is
    [true] the -quiet flag is given to ocamlbuild, which causes normal output
    to be suppressed (only errors are output). The main point is that it
    includes the -use-ocamlfind flag which we need for pretty much everything.
    Flags is optionally a list of additional arguments. *)
let ocb ?(flags=[]) ?(quiet=false) cmd =
  let args = if flags = [] then "" else " " ^ String.concat " " flags in
  if quiet then
    run @@ sprintf "ocamlbuild -quiet -use-ocamlfind%s %s" args cmd
  else
    run @@ sprintf "ocamlbuild -use-ocamlfind%s %s" args cmd

(** [mcase s] returns the string [s] with its first character uppercased (i.e.
    how OCaml gets module names from file names. *)
let mcase s =
  sprintf "%c%s"
    (Char.uppercase s.[0])
    (String.sub s 1 (String.length s - 1))

(** [check_prefix a b] returns [true] if [a] is a prefix of [b]. *)
let check_prefix a b =
  String.length a <= String.length b &&
  String.sub b 0 (String.length a) = a

(** [install path] moves the file at [path] to the parent directory,
    overwriting any file already there.
    It's used because we run ocamlbuild in the source directory, like it wants.
    But we store the sources in src/ and want the build outputs to go to its
    parent directory, the root of the repository. *)
let install path =
  run ("rm -rf ../" ^ path) ;
  run (sprintf "mv %s ../%s" path path)

let write_to_file path s =
  let och = open_out path in
  output_string och s ;
  close_out och



(** [modules ()] returns a list of the OCaml modules in the current directory.
    It does this by finding all the .ml files and calling [mcase] on the
    filenames. *)
let modules () =
  Sys.readdir "."
  |> Array.to_list
  |> List.filter (fun s -> List.exists (Filename.check_suffix s) [".ml"; ".mly"; ".mll"])
  |> List.map Filename.chop_extension
  |> List.map mcase

(** [write_module_list ?excludes dest] writes a list of the modules in the
    current directory, separated by newlines, to [dest]. We use it to create
    the .mllib, .odocl, and .mltop files that ocamlbuild wants, including all
    of the modules in the project. Modules named in [excludes] are excluded,
    as well as any modules suffixed _test. *)
let write_module_list ?(excludes=[]) ~dest =
  let mods = modules () in
  let out = Buffer.create 128 in
  List.iter
    (fun m ->
       if List.mem m excludes || Filename.check_suffix m "_test" then ()
       else Buffer.add_string out (m ^ "\n"))
    mods ;
  write_to_file dest (Buffer.contents out)

(** [with_module_list ?excludes dest f] calls [write_module_list ?excludes
    ~dest], then [f ()], then removes the created module list afterwards. So
    you don't have to remember to. *)
let with_module_list ?excludes ~dest f =
  write_module_list ?excludes ~dest ;
  f () ;
  run (sprintf "rm '%s'" dest)

(** [splice_file ?ml path tag s] splices the autogenerated text [s] into the
    file at [path]. If no file exists then a new one is created containing [s].
    If one already exist that doesn't contain a splice section tagged [tag]
    then [s] is spliced at the end of the file. Otherwise the existing splice
    section is replaced with [s]. A splice section looks like:

        #begin mk TAG
        S
        #end

    We use it to autogenerate portions of files like META and .merlin, which
    the user may want to edit (so we don't want to just overwrite the whole
    thing.)

    If [ml] is true then (* begin mk TAG *) and (* end *) are used for the
    start and end lines instead. *)
let splice_file ?(ml=false) path tag s =
  let start_line =
    if ml then sprintf "(* begin mk %s *)" tag
    else sprintf "# begin mk %s" tag
  in
  let end_line =
    if ml then "(* end *)"
    else "# end"
  in

  let out = Buffer.create 128 in
  let spliced = ref false in
  let splice () =
    assert (not !spliced) ;
    Buffer.add_string out (sprintf "%s\n%s\n%s\n" start_line s end_line) ;
    spliced := true ;
  in

  if not (Sys.file_exists path) then begin
    splice ()
  end else begin
    let inch = open_in path in
    let splicing = ref true in

    while !splicing do
      match input_line inch with
      | line when line = start_line && not !spliced ->
        splice () ;
        (* Keep reading until we get to the [end_line]. *)
        let skipping = ref true in
        while !skipping do
          match input_line inch with
          | s when s = end_line -> skipping := false
          | _ -> ()
          | exception End_of_file -> skipping := false
        done
      | line ->
        Buffer.add_string out line ;
        Buffer.add_char out '\n'
      | exception End_of_file ->
        if not !spliced then begin
          Buffer.add_char out '\n' ;
          splice ()
        end ;
        splicing := false
    done ;

    close_in inch ;
  end ;

  write_to_file path (Buffer.contents out)

(* A list of file extensions of artifacts to install with ocamlfind. *)
let desired_artifacts =
  [".cmi"; ".cmt"; ".ml"; ".mli"; ".cma"; ".cmxa"; ".a"]

(** [rules] is a alist of (name, group, procedure) tuples. Each specifies a
    subcommand for mk. For example, ./mk splice will call the procedure whose
    name is "splice". The [group] currently only affects [rule_all], which
    doesn't run "destructive" rules like clean and unlib (otherwise it'd delete
    the files it just created!) *)
let rules =
  [(* gen autogenerates:
      - requires and archive directives in META
      - S, B, and PKG directives in .merlin
      - package flags in _tags
      ... based on the dependencies listed in [requires].
      It's pointlessly tedious to have to edit three files every time you add a
      new dependency. *)
   ("gen",
    "Generate a META file and dependency lists in .merlin, and _tags.",
    Splice,
    fun { project; requires } ->
      let merlin =
        "S .\nB _build\n" ^ 
        String.concat "\n" (List.map (fun s -> sprintf "PKG %s" s) requires)
      in
      let tags = "true: " ^ String.concat ", " (List.map (fun s -> sprintf "package(%s)" s) requires) in
      let meta =
        sprintf
          "requires = \"%s\"\n\
           archive(byte) = \"%s.cma\"\n\
           archive(native) = \"%s.cmxa\""
          (String.concat " " requires) project project
      in
      splice_file "META" "META" meta (* wow such meta *) ;
      splice_file "_tags" "_tags" tags (* very tags *) ;
      splice_file ".merlin" ".merlin" merlin);

   ("reqs",
    "Print a list of the required packages listed in the config.",
    Print,
    fun { requires } ->
      List.iter print_endline requires);

   (* clean deletes the binaries created by other commands. It doesn't delete
      the spliced files, beacuse it makes sense to commit those and because you
      might have your own changes. *)
   ("clean",
    "Delete binaries created by other commands.",
    Destroy,
    fun { project; flags } ->
      ocb ~flags "-clean" ;
      chdir ".." ;
      run (sprintf "rm -f main.native main.d.byte %s.top %s.docdir" project project) ;
      chdir src_dir);

   (* byte builds main.d.byte using ocamlbuild from a src/main.ml file. *)
   ("byte",
    "Build main.d.byte from src/main.ml.",
    Build,
    fun { flags } ->
      ocb ~flags "main.d.byte" ;
      install "main.d.byte");

   (* opt builds main.native using ocamlbuild from a src/main.ml file. *)
   ("opt",
    "Build main.native from main.ml.",
    Build,
    fun { flags } ->
      ocb ~flags "main.native" ;
      install "main.native");

   (* top builds a custom toplevel, [project].top containing all the modules in
      the project except for Main and *_test.

      topgen will splice into [mcase project]_top.ml the following line:

          let () = UTop_main.main ()

      ... to have your top be based on UTop (this requires utop to be in the
      dependencies). It will also also splice a file called .ocamlinit in the
      root of the project (if that's where you're going to be running the top)
      with the contents:

          #thread
          #directory "src/_build"

      ... to set up the top properly.

   *)
   ("top",
    "Build a toplevel.",
    Build,
    fun { project; flags } ->
      with_module_list ~excludes:["Main"] ~dest:(sprintf "%s.mltop" project)
        (fun () ->
           let flags = "-pkg utop" :: "-tag thread" :: flags in
           ocb ~flags @@ sprintf "%s.top" project ;
           install @@ sprintf "%s.top" project)) ;

   ("topgen",
    "Splice support code for a toplevel in .ocamlinit and _top.ml.",
    Splice,
    fun { project; requires } ->
      let topfile = project ^ "_top.ml" in  
      splice_file ~ml:true "../.ocamlinit" "topgen" "#thread\n#directory \"src/_build\"" ;
      splice_file ~ml:true topfile "topgen" "let () = UTop_main.main ()" ;
   ) ;

   (* doc runs ocamldoc on all of the modules in your project except for *_test
      modules. The generated documentation is located at <project>.docdir. *)
   ("doc",
    "Build project documentation.",
    Build,
    (fun { project; flags } ->
       with_module_list ~excludes:[mcase project ^ "_top"] ~dest:(sprintf "%s.odocl" project)
         (fun () ->
            ocb ~flags @@ sprintf "%s.docdir/index.html" project ;
            install (sprintf "%s.docdir" project))));

   (* lib installs all of the modules in your project except for Main, *_test
      modules, and [mcase project]_top as an ocamlfind package named [package]. *)
   ("lib",
    "Install project modules as an ocamlfind package.",
    Install,
    (fun { project; package; flags } ->
       (* Remove this package if it's already installed. *)
       if has_package package then
         run (sprintf "ocamlfind remove %s >/dev/null" package)
       else () ;

       with_module_list
         ~excludes:["Main"; mcase project ^ "_top"]
         ~dest:(sprintf "%s.mllib" project)
         (fun () ->
            (* Bytecode. *)
            ocb ~flags @@ sprintf "%s.cma" project ;
            (* Native code. *)
            ocb ~flags @@ sprintf "%s.cmxa" project ;

            let artifacts =
              Sys.readdir "_build"
              |> Array.to_list
              |> List.map (fun s -> "_build/" ^ s)
              |> List.filter (fun s -> not (Sys.is_directory s))
              |> List.filter (fun s -> List.exists (fun f -> Filename.check_suffix s f) desired_artifacts)
              |> List.filter (fun s ->
                  let s' = Filename.chop_extension @@ Filename.basename s in
                  not (s' = "main" || s' = "main.d" || s' = project ^ "_top")
                )
              |> String.concat " "
            in

            run (sprintf "ocamlfind install %s META %s >/dev/null 2>&1" package artifacts))));

   (* unlib removes the package created by lib named [package]. *)
   ("unlib",
    "Delete the ocamlfind package created by lib.",
    Destroy,
    (fun { package } ->
       run (sprintf "ocamlfind remove %s" package)));

   (* test finds all the files named *_test.ml, builds them to bytecode with
      debugging flags, then runs them with backtraces enabled. *)
   ("test",
    "Run test files.",
    Test,
    (fun { flags } ->
       let test_files =
         Sys.readdir "."
         |> Array.to_list
         |> List.filter (fun s -> Filename.check_suffix s "_test.ml")
       in
       with_log_commands false
         (fun () ->
            List.iter
              (fun test ->
                 let out = Filename.chop_extension test ^ ".d.byte" in
                 note "Test" "%s" test ;
                 ocb ~flags ~quiet:true out ;
                 chdir ".." ;
                 run ({|OCAMLRUNPARAM="b" |} ^ Filename.concat src_dir out) ;
                 chdir src_dir ;
                 run ("rm " ^ out))
              test_files)));

   ("run",
    "Run main or a specified file.",
    Run,
    (fun { flags; args; run_args } ->
       let target =
         match args with
         | [] -> Some "main.ml"
         | [s] -> Some (s ^ ".ml")
         | _ -> None
       in
       match target with
       | None ->
         error "Expected run:[name]."
       | Some s ->
         if not (Sys.file_exists s) then
           error @@ sprintf "Couldn't find a file named %s.ml." s
         else
           let out = Filename.chop_extension s ^ ".d.byte" in
           with_log_commands false
             (fun () ->
                ocb ~flags ~quiet:true out ;
                chdir ".." ;
                run' ~env:["OCAMLRUNPARAM=b"] ~args:run_args
                  (sprintf "%s/%s" src_dir out) ;
                chdir src_dir ;
                run @@ "rm " ^ out)));
  ]

(** [help ()] displays a help message then exits with code 1. *)
let help () =
  printf "\x1b[34mUsage\x1b[0m" ;
  print_endline " car [rule]*" ;
  print_endline "A collection of aliases for common tasks on OCaml projects using ocamlbuild." ;
  print_endline "" ;

  (* Find the maximum length of the name of a rule so we can pad the names in the listing. *)
  let max_n = ref 0 in
  List.iter
    (fun (name, _, _, _) ->
       let n = String.length name in
       if n > !max_n then max_n := n)
    rules ;

  let show_rule name desc group =
    let color =
      if is_scary group then "33" (* yellow *)
      else "32" (* green *)
    in
    printf "\x1b[%sm%s\x1b[0m" color name ;
    print_endline (String.make (!max_n - String.length name + 2) ' ' ^ desc)
  in

  show_rule "init" (sprintf "Create an initial %s file." config_path) Splice ;

  (* Print a listing of all the rules and their descriptions. *)
  List.iter (fun (name, desc, group, _) -> show_rule name desc group) rules ;
  print_endline "" ;
  Printf.printf "If you don't supply a rule, all rules will run but: %s.\n"
    (rules
     |> List.filter (fun (_, _, group, _) -> is_scary group)
     |> List.map (fun (name, _, _, _) -> name)
     |> String.concat ", ") ;
  exit 1

(** [init ()] tries to initialize a config file at [config_path]. *)
let init () =
  if Sys.file_exists config_path then
    error @@ sprintf "A %s file already exists. Delete it if you want to make a new one." config_path
  else begin
    let package = Filename.basename @@ Sys.getcwd () in
    write_to_file config_path @@
    sprintf
      "# The project name. Used to name library files, the top binary, and the docdir.\n\
       project = \"%s\"\n\
       # The ocamlfind package name.\n\
       package = \"%s\"\n\
       # A list of ocamlfind packages required by this project.\n\
       requires = []\n\
       # A list of additional flags to pass to ocamlbuild.\n\
       flags = []\n"
      Str.(global_replace (regexp "-") "_" package)
      package ;
    run @@ sprintf "$EDITOR %s" config_path
  end

(** [rule config name] runs the rule named [name] if it exists. If no
    such rule exists, we print an error is printed then [exit 1]. *)
let rule config name =
  if Filename.check_suffix name "help" then help ()
  else
    let rec find_rule = function
      | [] -> raise Not_found
      | (name', _, group, proc) :: rs ->
        if name' = name then group, proc else find_rule rs
    in
    match find_rule rules with
    | group, proc ->
      if is_scary group then
        scary "Rule" "%s" name
      else 
        action "Rule" "%s" name ;
      proc config
    | exception Not_found ->
      error @@ sprintf "No such rule: %s" name

(** [rule_all config] executes every rule except for those in [scary_groups]. *)
let rule_all config =
  List.iter
    (fun (name, _, group, _) ->
       if is_scary group then ()
       else begin
         rule config name ;
         print_endline ""
       end)
    rules

let parse_arg s =
  match Str.(split (regexp ":") s) with
  | [rule; args] -> Some (rule, Str.(split (regexp ",") args))
  | [rule] -> Some (rule, [])
  | _ -> None

let split_argv () =
  let rec split a i =
    if i = Array.length Sys.argv then
      (List.rev a, [])
    else if Sys.argv.(i) = "--" then
      (List.rev a,
       Array.sub Sys.argv (i + 1) (Array.length Sys.argv - i - 1)
       |> Array.to_list)
    else
      split (Sys.argv.(i) :: a) (i + 1)
  in split [] 1

(* Here we go! *)
let () =
  let asking_for_help =
    List.exists
      (fun s -> Filename.check_suffix s "help")
      (Array.to_list Sys.argv)
  in
  let argc = Array.length Sys.argv in

  if asking_for_help then help ()
  else if argc = 2 && Sys.argv.(1) = "init" then init ()
  else begin
    let config = load_config () in
    chdir src_dir ;
    if argc = 1 then rule_all config
    else begin
      let commands, run_args = split_argv () in
      let commands = List.map parse_arg commands in
      if List.exists (function None -> true | _ -> false) commands then
        help ()
      else
        commands
        |> List.map (function Some x -> x | None -> assert false)
        |> List.iter (fun (name, args) -> rule { config with args; run_args } name)
    end
  end

(* vim: set filetype=ocaml : *)