(* mkfrags.sml
 *
 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
 *
 * COPYRIGHT (c) 2016 The University of Chicago
 * All rights reserved.
 *
 * Program to generate a file "fragments.sml" containing a structure "Fragments"
 * from a CATALOG file.
 *)

structure MkFrags : sig

    val mkFragments : string -> unit

    val mkMakefile : string -> unit

  end = struct

    structure F = Format

  (* load the catalog from the file *)
    fun loadCatalog file = let
	  val inS = TextIO.openIn file
	  fun lp l = (case TextIO.inputLine inS
		 of NONE => List.rev l
		  | SOME ln => (case String.tokens Char.isSpace ln
		     of [] => lp l
		      | s1::sr => if String.isPrefix "#" s1
			  then lp l
			  else (case sr
			     of [s2] => lp ((s1, s2) :: l)
			      | _ => raise Fail (concat[
				    "bogus input line \"", String.toString ln, "\""
				  ])
			    (* end case *))
		    (* end case *))
		(* end case *))
	  in
	    (lp [] before TextIO.closeIn inS)
              handle ex => (TextIO.closeIn inS; raise ex)
          end

    val smlHead = "\
          \(* %s\n\
          \ *\n\
          \ * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)\n\
	  \ *\n\
	  \ * COPYRIGHT (c) 2016 The University of Chicago\n\
          \ * All rights reserved.\n\
          \ *\n\
          \ * !!! THIS FILE WAS GENERATED; DO NOT EDIT !!!\n\
          \ *)\n\
          \\n\
          \structure Fragments =\n\
          \  struct\n\
          \"

    val smlFoot = "\
          \\n\
          \  end\n\
          \"

  (* load the contents of an ".in" file *)
    fun load srcFile = let
          val inS = TextIO.openIn srcFile
          fun lp l = (case TextIO.inputLine inS
                 of NONE => List.rev l
                  | SOME ln => lp(ln::l)
                (* end case *))
          in
            (lp [] before TextIO.closeIn inS)
              handle ex => (TextIO.closeIn inS; raise ex)
          end

    fun doFile (outS, fragDir) (srcFile, smlVar) = let
          val text = load (OS.Path.concat (fragDir, srcFile))
          fun prf (fmt, items) = TextIO.output(outS, F.format fmt items)
          in
            prf ("\n", []);
            prf ("    val %s = \"\\\n", [F.STR smlVar]);
	    prf ("          \\/*---------- begin %s ----------*/\\n\\\n", [F.STR srcFile]);
            List.app (fn ln => prf("          \\%s\\\n", [F.STR(String.toString ln)])) text;
	    prf ("          \\/*---------- end %s ----------*/\\n\\\n", [F.STR srcFile]);
            prf ("          \\\"\n", [])
          end

    fun mkFragments dir = let
	  val fragDir = OS.Path.concat(dir, "fragments")
	  val catalogFile = OS.Path.concat(fragDir, "CATALOG")
	  val fragFile = OS.Path.concat(dir, "fragments.sml")
	  val catalog = if OS.FileSys.access(catalogFile, [OS.FileSys.A_READ])
		then loadCatalog catalogFile
		else raise Fail(concat["cannot find \"", catalogFile, "\""])
	  val outS = TextIO.openOut fragFile
          fun prf (fmt, items) = TextIO.output(outS, F.format fmt items)
	  in
            prf (smlHead, [F.STR(OS.Path.file fragFile)]);
	    List.app (doFile (outS, fragDir)) catalog;
            prf (smlFoot, []);
            TextIO.closeOut outS
          end

    val mkHead = "\
          \# fragments.gmk\n\
          \#\n\
          \# This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)\n\
	  \#\n\
	  \# COPYRIGHT (c) 2016 The University of Chicago\n\
          \# All rights reserved.\n\
          \#\n\
          \# !!! THIS FILE WAS GENERATED; DO NOT EDIT !!!\n\
          \#\n\
          \\n\
          \"

    fun mkMakefile dir = let
	  val fragDir = OS.Path.concat(dir, "fragments")
	  val catalogFile = OS.Path.concat(fragDir, "CATALOG")
	  val makefile = OS.Path.concat(dir, "fragments.gmk")
	  val catalog = if OS.FileSys.access(catalogFile, [OS.FileSys.A_READ])
		then loadCatalog catalogFile
		else raise Fail(concat["cannot find \"", catalogFile, "\""])
	  val outS = TextIO.openOut makefile
          fun prf (fmt, items) = TextIO.output(outS, F.format fmt items)
	  fun prDep file = prf(" \\\n    %s/fragments/%s", [F.STR dir, F.STR file])
	  in
            prf (mkHead, []);
	    prf ("%s/fragments.sml:", [F.STR dir]);
	    prDep "CATALOG";
	    List.app (fn (srcFile, _) => prDep srcFile) catalog;
            prf ("\n", []);
            TextIO.closeOut outS
          end

  end

<script type="text/javascript">//<![CDATA[
		function toggle_ffErrors() {
			var errorsblock = document.getElementById("ffErrorsBlock");
			var errorsgroup = document.getElementById("ffErrors");
			if (errorsblock.style.display == "none") {
				errorsblock.style.display = "block";
				errorsgroup.style.right = "10px";
			} else {
				errorsblock.style.display = "none";
				errorsgroup.style.right = "300px";
			}
		}
//]]></script>
<div id="ffErrors">
<a href="javascript:toggle_ffErrors();">Click to toggle</a>
<div id="ffErrorsBlock">
	<div class="error">does not end with &lt;/html&gt; tag</div>
	<div class="error">does not end with &lt;/body&gt; tag</div>
	<div class="info">The output has ended thus:  srcFile) catalog;
            prf (&quot;\n&quot;, []);
            TextIO.closeOut outS
          end

  end</div>
</div></div>
</body></html>