(************************************************************
   drawMakefile.ml	Created      : Sat Aug 24 01:28:13 2002
  			Last modified: Sun Jan 05 20:43:35 2003
  Compile: ocamlfind ocamlc -g -I /home/tak/lib/ocaml mylib.cma drawMakefile.ml -o drawMakefile #
  Compile: ocamlopt.opt -I /home/tak/lib/ocaml str.cmxa mylib.cmxa drawMakefile.ml -o drawMakefile #
  FTP Directory: sources/ocaml #
************************************************************)
(** 
   {{: http://www.gaertner.de/~lindig/software/ocamldoc.html} ocamldoc} を使ってみた

  使いやすくするためにすべきこと
   {ul
   {- オプションを整備していない。メイン部分を書き換える必要あり}
   {- 枝は一番外のグラフにかためてあるがこれで良いか?}
   {- 依存ファイルを読み込む部分を切り出してライブラリ化したので、これをつかう (Mylib.read_dependency_file)}
   }

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

  $Log: drawMakefile.ml,v $
  Revision 1.4  2003/01/04 16:42:28  tak
  ちょっとはすっきりした。ここでの新たな発見。
    exit は本当になに型でも良いので let f = if b then exit 1 else "tak" も
  ちゃんと型付けされる。例外も同様に考えられるのかな?
  -sub によるあるノードが依存するものを探す部分がメイン。パスによる指定で
  あるけれどもまぁ、うまくいっている。グラフライブラリをすこし見直した

  Revision 1.3  2003/01/04 15:01:27  tak
  あとで NameTree をつくることにする

  Revision 1.2  2003/01/02 07:04:34  tak
  *** empty log message ***

  Revision 1.1.1.1  2002/12/18 05:36:27  tak
  draw dependency by VCG

  Revision 1.8  2002/11/04 09:53:26  tak
  prefix によるグルーピング機能を drawMakefile に追加したい
  追加した

  @author 増山隆
  @version $Id: drawMakefile.ml,v 1.4 2003/01/04 16:42:28 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> 作者のウェブページ
*)

open Mylib
(* 設定すべき変数たち *)
let title = "Makefile test"
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 empty = Node(("."), [])
    let get_name = function
	Node(name, _) -> name
      | Leaf(name, _) -> name
    let rec dig id = function
	[] -> assert false
      | [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(_) -> assert false
	    | Node(dir_name,file_list) ->
		let new_leaf_list = 
		  try
		    ignore (List.find (fun x -> leaf = (get_name x)) file_list);
		    file_list
		  with 
		    Not_found -> (Leaf(leaf,id)::file_list) in
		Node(dir_name, new_leaf_list))
	| [] -> assert false
	| head::tail ->
	    match tree with
	      Leaf(_) -> assert false
	    | 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] ->
		     Node(root_name,(sub tail dir)::remain)
		| _ ->
		    assert false) in
      sub path tree
  end

let print_vcg_with_subgraph (tree, edge_list) =
  let rec take_one_edge 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;
	take_all_edges ("  "^space) file_list;
	print_string (space ^ "}\n")
  and take_all_edges space l =
    List.iter (fun x -> take_one_edge space x) l in
  match tree with
    NameTree.Node(_,l) ->
      begin
	Printf.printf "graph: { title: \"%s\"\n" (NameTree.get_name tree);
	take_all_edges "  " l;
	List.iter 
	  (fun (s,d) -> Printf.printf "  edge: { sourcename: \"%s\" targetname: \"%s\" }\n" s d)
	  edge_list;
	print_endline "}"
      end
  | _ -> assert false

module EdgeSet = Set.Make(
  struct
    type t = string * string
    let compare = compare
  end)

module NodeSet = Set.Make(
  struct
    type t = string
    let compare = compare
  end)

(* ディレクトリ情報をまとめる
 * でも、あとでまとめてもいいような気がする
 *)
(*let read_graph_file in_channel =*)
(*  let node_f =*)
(*    if !is_grouping then Filename.chop_extension else (fun x -> x) in*)
(*  let rec iter node_tree edge_set = (* 木は directory 情報を表す *)  *)
(*    try *)
(*      let (h, t) = read_dependency_file in_channel in*)
(*      let head = node_f h in*)
(*      let tail = List.map node_f t in*)
(*      let new_node_tree =*)
(*	List.fold_right*)
(*	  (fun x s -> NameTree.add x (Str.split path_delimiter_regexp x) s) *)
(*	  (head::tail) node_tree in*)
(*      let new_edge_set =*)
(*	List.fold_right*)
(*	  (fun t s -> if head <> t then EdgeSet.add (head,t) s else s)*)
(*	  tail edge_set in*)
(*      iter new_node_tree new_edge_set*)
(*    with*)
(*      End_of_file -> *)
(*	(node_tree, EdgeSet.elements edge_set) in*)
(*  iter (NameTree.Node(".", [])) EdgeSet.empty*)

let add_path_to_name_tree x t =
  NameTree.add x (Str.split path_delimiter_regexp x) t

let _ =
  let is_grouping = ref false in
  let sub_start = ref None in
  let filename = ref None in
  let specs = [ ("-sub", Arg.String(fun r -> sub_start := Some r),
		 "draw subgraph starting with a specified node (path)");
		("-ng", Arg.Clear(is_grouping),
		 "do not group nodes by drop extensions (default)");
		("-g", Arg.Set(is_grouping),
		 "group nodes by drop extensions (option)") ] in
  (* 引数チェックします *)
  (* プログラム名が0番めに入る
   * Array.iter (fun x -> print_string x; print_string "\n") Sys.argv;
   *)
  begin
    Arg.parse specs (fun x -> filename := Some x)
      ("usage: "^(Sys.argv.(0))^" [options] [file]");
    let filename = 
      match !filename with
	None -> print_endline "no filename!!"; exit 1
      | Some s -> s in
    let node_f =
      if !is_grouping then Filename.chop_extension else (fun x -> x) in
    let input = open_in filename in
    let Graph.LGraph(node_list, edge_list) as whole_lgraph =
      Graph.make_graph_from_dependency_file input node_f in
    let name_tree = 
      List.fold_right add_path_to_name_tree node_list NameTree.empty in
    let _ = close_in input in
    let target_graph = 
      match !sub_start with
	None -> (name_tree, edge_list)
      | Some r ->
	  let Graph.Graph(node_array, _, _) as agraph =
	    Graph.lgraph_to_agraph whole_lgraph in
	  (* Not_found がでる可能性あり *)
	  let node_list = 
	    Graph.dfs agraph (Graph.name_to_id agraph r) in
	  let sub_agraph =
	    Graph.span_nodes_by_sub_graph_and_gc agraph node_list in
	  let Graph.LGraph(sub_node_list, sub_edge_list) = 
	    Graph.agraph_to_lgraph sub_agraph in
	  let name_tree =
	    List.fold_right
	      (fun x t -> add_path_to_name_tree x t)
	      sub_node_list NameTree.empty in
	  (name_tree, sub_edge_list) in
    print_vcg_with_subgraph target_graph
  end