(* goaljobs
 * Copyright (C) 2013 Red Hat Inc.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License along
 * with this program; if not, write to the Free Software Foundation, Inc.,
 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 *)

open Unix
open Printf

type goal_result_t = Goal_OK | Goal_failed of string
exception Goal_result of goal_result_t

let goal_failed msg = raise (Goal_result (Goal_failed msg))

let target v =
  if v then raise (Goal_result Goal_OK)
let target_all vs = target (List.fold_left (&&) true vs)
let target_exists vs = target (List.fold_left (||) false vs)
let require () = ()

let file_exists = Sys.file_exists

let file_newer_than f1 f2 =
  let stat f =
    try Some (stat f)
    with
    | Unix_error (ENOENT, _, _) -> None
    | Unix_error (err, _, _) ->
      let msg = sprintf "file_newer_than: %s: %s" f (error_message err) in
      goal_failed msg
  in
  let s1 = stat f1 and s2 = stat f2 in
  match s1 with
  | None -> false
  | Some s1 ->
    match s2 with
    | None ->
      let msg = sprintf "file_newer_than: %s: file does not exist" f2 in
      goal_failed msg
    | Some s2 ->
      s1.st_mtime >= s2.st_mtime

let more_recent objs srcs =
  if not (List.for_all file_exists objs) then false
  else (
    List.for_all (
      fun obj -> List.for_all (file_newer_than obj) srcs
    ) objs
  )

let url_exists url = goal_failed "url_exists not implemented!"

let sh fs =
  let do_sh cmd =
    let cmd = "set -e\nset -x\n\n" ^ cmd in
    let r = Sys.command cmd in
    if r <> 0 then (
      let msg = sprintf "external command failed with code %d" r in
      goal_failed msg
    )
  in
  ksprintf do_sh fs

let do_shlines cmd =
  let cmd = "set -e\nset -x\n\n" ^ cmd in
  let chan = open_process_in cmd in
  let lines = ref [] in
  let rec loop () =
    let line = input_line chan in
    lines := line :: !lines;
    loop ()
  in
  (try loop () with End_of_file -> ());
  let r = close_process_in chan in
  match r with
  | WEXITED 0 -> List.rev !lines
  | WEXITED i ->
    let msg = sprintf "external command failed with code %d" i in
    goal_failed msg
  | WSIGNALED i ->
    let msg = sprintf "external command was killed by signal %d" i in
    goal_failed msg
  | WSTOPPED i ->
    let msg = sprintf "external command was stopped by signal %d" i in
    goal_failed msg
let shlines fs = ksprintf do_shlines fs

let do_shout cmd =
  let lines = do_shlines cmd in
  String.concat "\n" lines
let shout fs = ksprintf do_shout fs

(*
val shell : string ref
*)

(*
val replace_substring : string -> string -> string -> string
*)

let change_file_extension ext filename =
  let i =
    try String.rindex filename '.'
    with Not_found -> String.length filename in
  String.sub filename 0 i ^ "." ^ ext

(*
val filter_file_extension : string -> string list -> string
*)

(* XXX The Memory is not actually persistent yet. *)
let memory = Hashtbl.create 13

let memory_exists = Hashtbl.mem memory
let memory_set = Hashtbl.replace memory
let memory_get k = try Some (Hashtbl.find memory k) with Not_found -> None
let memory_delete = Hashtbl.remove memory

let published_goals = ref []
let publish name fn = published_goals := (name, fn) :: !published_goals
let get_goal name =
  try Some (List.assoc name !published_goals) with Not_found -> None

let goal_file_exists filename =
  if not (file_exists filename) then (
    let msg = sprintf "file '%s' required but not found" filename in
    goal_failed msg
  )
let goal_file_newer_than f1 f2 =
  if not (file_newer_than f1 f2) then (
    let msg = sprintf "file %s is required to be newer than %s" f1 f2 in
    goal_failed msg
  )
let goal_more_recent objs srcs =
  if not (more_recent objs srcs) then (
    let msg = sprintf "object(s) %s are required to be newer than source(s) %s"
      (String.concat " " objs) (String.concat " " srcs) in
    goal_failed msg
  )
let goal_url_exists url =
  if not (url_exists url) then (
    let msg = sprintf "url_exists: URL '%s' required but does not exist" url in
    goal_failed msg
  )
let goal_memory_exists k =
  if not (memory_exists k) then (
    let msg = sprintf "memory_exists: key '%s' required but does not exist" k in
    goal_failed msg
  )

(* Run the program. *)
let init () =
  let prog = Sys.executable_name in
  let prog = Filename.basename prog in

  let args = ref [] in

  let display_version () =
    printf "%s %s\n" Config.package_name Config.package_version;
    exit 0
  in

  let list_goals () =
    let names = !published_goals in
    let names = List.map fst names in
    let names = List.sort compare names in
    List.iter print_endline names
  in

  let argspec = Arg.align [
    "--goals", Arg.Unit list_goals, " List all goals";
    "-l", Arg.Unit list_goals, " List all goals";
    "-V", Arg.Unit display_version, " Display version number and exit";
    "--version", Arg.Unit display_version, " Display version number and exit";
  ] in
  let anon_fun str = args := str :: !args in
  let usage_msg = sprintf "\
%s: a script generated by goaljobs

List all goals:                %s -l
Run a single goal like this:   %s <name-of-goal> [<goal-args ...>]

For more information see the goaljobs(1) man page.

Options:
" prog prog prog in

  Arg.parse argspec anon_fun usage_msg;

  let args = List.rev !args in

  (* Was a goal named on the command line? *)
  match args with
  | name :: args ->
    (match get_goal name with
    | Some fn -> fn args
    | None ->
      eprintf "error: no goal called '%s' was found.\n" name;
      eprintf "Use %s -l to list all published goals in this script.\n" name;
      exit 1
    )
  | [] ->
    (* Does a published 'all' goal exist? *)
    match get_goal "all" with
    | Some fn -> fn []
    | None ->
      (* No published 'all' goal.  This is only a warning, because
       * other top-level code may exist in the script.
       *)
      eprintf "warning: no 'all' goal found.\n"