(************************************************************
   drawMakefile.ml	Created      : Sat Aug 24 01:28:13 2002
  			Last modified: Wed Oct 02 15:01:01 2002
  Compile: ocamlopt.opt str.cmxa drawMakefile.ml -o drawMakefile #
  Compile: ocamlc str.cma drawMakefile.ml -g -o drawMakefile #
  Compile: ocamldoc -html -d doc -warn-error drawMakefile.ml
************************************************************)
(** 
   {{: http://www.gaertner.de/~lindig/software/ocamldoc.html} ocamldoc} を使ってみた

  使いやすくするためにすべきこと
   {ul
   {- オプションを整備していない。メイン部分を書き換える必要あり}
   {- 枝は一番外のグラフにかためてあるがこれで良いか?}
   }

   ocamldocについてのコメント
{v
   (**
    *
    *)
v}
  のようなコメントを書くと途中の*が表示されてかっちょわるくなる。

   @author 増山隆
  @version $Id: drawMakefile.ml,v 1.4 2002/08/30 03:47:45 tak Exp $
  @see <http://www002.upp.so-net.ne.jp/mamewo/ml.html#Pervasives> Pervasivesモジュールの説明
  @see <http://www002.upp.so-net.ne.jp/mamewo/ml.html> 作者のウェブページ
*)

exception Error of string

(* 設定すべき変数たち *)
let title = "Makefile test"
let edge_class = 2
let path_delimiter_regexp = Str.regexp "/"

(** 
  実験。実験
  名前とIDのペアを要素とする木
 *)
module NameTree =
  struct
    type elt = string * string
    type t =
	Node of string * (t list) | Leaf of elt
(*    let get_id*)
    let empty = Node(("."),[])
    let get_name = function
	Node(name,_) -> name
      | Leaf(name,_) -> name
(*    let get_id = function*)
(*	Node((),_) -> Element.get_name res*)
(*      | Leaf(res) -> Element.get_name res*)
    let rec dig id = function
	[] -> raise (Error "assert no reached\n")
      | [file] -> Leaf(file,id)
      | head::tail ->
	  Node(head,[(dig id tail)]) 

	    (** 
	       @param path パスを文字列リストで表したもの
	       @param tree 要素を足す木
	     *)
    let add id path tree =
      let rec sub path tree =
	match path with 
	  [leaf] -> 
	    (match tree with 
	      Leaf(_) -> raise (Error "can't add to leaf\n")
	    | Node(dir_name,file_list) ->
		Node(dir_name,(try
		  ignore (List.find (fun x -> leaf = (get_name x)) file_list);
		  file_list
		with 
		  Not_found ->
		    (Leaf(leaf,id)::file_list))))
	| [] ->
	    raise (Error "assert no reached\n")
	| head::tail ->
	    match tree with
	      Leaf(_) -> raise (Error "can't add to leaf\n")
	    | Node(root_name , file_list) ->
		let (next,remain) = 
		  List.partition (fun x -> head = (get_name x)) file_list in
		(match next with 
		  [] ->
		  (* 一直線に掘っていく mkdir -p みたいに*)
		    Node(root_name,(dig id path)::remain)
		| [dir] ->
(*		    (print_string "found !\n";*)
		     Node(root_name,(sub tail dir)::remain)
		| _ ->
		    raise 
		      (Error ("directorys with a same name detected: " ^ head ^ "\n"))) in
      sub path tree
  end

(* Application *)

let input_line_with_escape in_channel =
  let result = ref "" in
  let is_continue = ref true in
  let count = ref 0 in
  try
    while !is_continue do
      let line = input_line in_channel in
      let length = String.length line in
      begin
	is_continue := (String.get line (length-1) = '\\');
	incr count;
	if !is_continue then
	  if length > 2 then
	    result := !result ^ (String.sub line 0 (length-2))
	  else ()
	else
	  result := !result ^ line
      end
    done;
    !result
  with
    End_of_file ->
      if !count = 0 then
	raise End_of_file
      else
	!result

let print_vcg tree =
  let rec sub space = function
      NameTree.Leaf(name,id) ->
	Printf.printf "%snode: { title:\"%s\" label: \"%s\" }\n" space id name
    | NameTree.Node(name,file_list) ->
	Printf.printf "%sgraph: { title:\"%s\"\n" space name;
	List.iter (fun x -> sub ("  "^space) x)  file_list;
	print_string (space ^ "}\n") in
  sub "  " tree

let read_file in_channel =
  let dependency_regexp =
    Str.regexp "^\\([/.a-zA-Z0-9_-]+\\):+ *\\(.+\\)$" in
  let spaces_regexp =
    Str.regexp "[ \t]+" in
  let edge_list = ref [] in
  let root = ref (NameTree.Node(".",[])) in
  begin
    try
      while true do
	let line = input_line_with_escape in_channel in
	if Str.string_match dependency_regexp line 0 then
	  let head = Str.matched_group 1 line in
	  let tail_list = Str.split spaces_regexp (Str.matched_group 2 line) in
	  begin 
(*	    Printf.printf "looping... %s\n" head;*)
	    root := NameTree.add head (Str.split path_delimiter_regexp head) !root;
	    List.iter (fun x -> edge_list := (head,x)::!edge_list) tail_list;
	    List.iter (fun x -> root := NameTree.add (snd x) (fst x) !root)
	      (List.map (fun x -> (Str.split path_delimiter_regexp x),x) tail_list)
	  end
      done;
      ()
(*      !root*)
    with
      End_of_file -> 
	(match !root with
	  NameTree.Node(name,list) ->
	    begin
	      Printf.printf "graph: { title: \"%s\"\n" name;
	      List.iter (fun x -> print_vcg x) list;
	      List.iter
		(fun x -> (Printf.printf 
			     "  edge: { sourcename: \"%s\" targetname: \"%s\" class: 2}\n"
			     (fst x) (snd x))) !edge_list;
	      print_string "}\n";	      
	    end
	| NameTree.Leaf(name,_)
	  -> ());
  end

let _ =
  let print_usage () = Printf.printf "Usage: %s [filename]\n" Sys.argv.(0) in
  (* 引数チェックします *)
  (** ふつうのシェルと同様でプログラム名が0番めに入る
     Array.iter (fun x -> print_string x; print_string "\n") Sys.argv;
   **)
  if Array.length Sys.argv != 2 then
    begin print_usage (); exit 1 end;
  let input = open_in Sys.argv.(1) in
  begin
    read_file input;
    close_in input
  end

(*open NameTree*)
(*let a = add ["hoge"; "soge"] empty;;*)