(*
 * Simple but effective .fgl file generation
 * This works specifically for sml/nj, which just
 * copies a big directory structure, respecting the
 * original structure (thus the use of the prefix)
 * 
 *)

structure Fgl = struct


  (* 
   * path tree representation
   *)
  datatype node = Leaf of string
                | Dir of string * node list

  local 
    fun find' (name,[]) = NONE
      | find' (name,x::xs) = case x
                               of Leaf (s) => if s=name
                                                then SOME (x)
                                              else find' (name,xs)
                                | Dir (s,_) => if s=name
                                                 then SOME (x)
                                               else find' (name,xs)
    fun remove (name,[]) = []
      | remove (name,x::xs) = case x
                                of Leaf (s) => if s=name
                                                 then xs
                                               else x::(remove (name,xs))
                                 | Dir (s,_) => if s=name
                                                  then xs
                                                else x::(remove (name,xs))
  in
    fun find (name,xs) = case (find' (name,xs))
                           of NONE => NONE
                            | SOME (pt) => SOME (pt,remove (name,xs))
  end


(*  fun concat_path (s1,s2) = if (s1="") then s2
                            else s1^"\\"^s2 (* OS.Path.concat (s1,s2) *)*)

  (* 
   * constuct a new single path 
   *)
  fun new_path (s,[]) = Leaf (s)
    | new_path (s,x::xs) = Dir (s,[new_path (x,xs)])

  (*
   * add a path to an existing path (matching first arc)
   *)
  fun add_path (s,[],Leaf (_)) = Leaf (s)
    | add_path (s,xs,Leaf _) = raise Fail "adding to leaf"
    | add_path (s,[],Dir _) = raise Fail "stopping at dir"
    | add_path (s,xs,Dir (_,nodelist)) = Dir (s,walk (xs,nodelist))
  
  (* 
   * walk a path_tree trying to fit in the current path
   *)
  and walk ([],nodelist) = []
    | walk (x::xs,nodelist) = case (find (x,nodelist))
                                of NONE => (new_path (x,xs))::nodelist
                                 | SOME (node,nodelist') => 
                                     (add_path (x,xs,node))::nodelist'


  fun dump (xs) = let
    fun spaces (n) = String.implode (List.tabulate (n,fn _ => #" "))
    fun dump' ([],_) = ()
      | dump' ((Leaf s)::xs,n) = (print (spaces (n));
                                  print s;
                                  print "\n";
                                  dump' (xs,n))
      | dump' ((Dir (s,pt))::xs,n) = (print (spaces (n));
                                      print s;
                                      print "\n";
                                      dump' (pt,n+2);
                                      dump' (xs,n))
  in
    dump' (xs,0)
  end

  fun concatWith sep [] = ""
    | concatWith sep [x] = x
    | concatWith sep (x::xs) = concat [x,sep,concatWith sep xs]

  (*
   * take a list of files and create a path tree 
   *)
  fun make_pt [] = []
    | make_pt (x::xs) = let
        val pt = make_pt (xs)
        (* first convert path to NT path *)
        val x = concatWith "\\" (String.tokens (fn #"/" => true | _ => false) x)
        val {arcs,...} = OS.Path.fromString (x) 
      in
        walk (arcs,pt)
      end

  (*
   * read off all the files at a single level, and all the subdirs 
   *)
  fun read_level (path, nodelist) = let
    val files = foldr (fn (Leaf (s),str) => (OS.Path.concat (path,s))::str
                        | (Dir _,str) => str) [] nodelist
    val dirs = foldr (fn (Leaf _,str) => str
                       | (Dir (s,nl),str) => (OS.Path.concat (path,s),nl)::str)
                     [] nodelist
  in
    (path,files,dirs)
  end
                   

  fun mapI f l = let
    fun iterMapI f [] i = []
      | iterMapI f (x::xs) i = (f (x,i))::(iterMapI f xs (i+1))
  in
    iterMapI f l 0
  end


  (* 
   * dump a pathtree in .ini file format specified
   * by IS6.2
   *)
  fun convert_pt (prefix,pt) = let
    val general_section = {name="General",
                           bindings= [{name="Type",value="FILELIST"},
                                      {name="Version",value="1.10.000"}]}
    val (_,top_files,top_dirs) = read_level ("",pt)
    fun dump_sections [] = []
      | dump_sections (section::sections) = (dump_section (read_level section))@
                                               (dump_sections sections)
    and dump_section (name, files,dirs) = let
      val file_bindings = mapI (fn (s,i) => {name="file"^(Int.toString i),
                                             value=OS.Path.concat (prefix,s)})
                               files
      val dir_bindings = mapI (fn ((s,_),i) => {name="SubDir"^(Int.toString i),
                                                value=s}) dirs
    in
      ({name=name,
        bindings={name="fulldirectory", value=""}::
                 
                 (file_bindings@dir_bindings)})::(dump_sections dirs)
    end
  in
    {sections=general_section::(dump_section ("TopDir",top_files,top_dirs))}
  end

  fun read_lines (instream) = let
    val i = TextIO.inputLine (instream)
  in
    if (i="") then []
    else (String.substring (i,0,size(i)-1))::(read_lines (instream))
  end

  fun make_fgl (input,output,prefix) = let
    val input' = TextIO.openIn (input)
    (* skip the first two description lines *)
    val (_::_::files) = read_lines (input')
    val pt = make_pt (files)
    val ini = convert_pt (prefix,pt)
  in
    IniFile.write (output,ini);
    TextIO.closeIn (input')
  end

end
