(* file-tree.sml
 *
 * COPYRIGHT (c) 2020 The Fellowship of SML/NJ (http://www.smlnj.org)
 * All rights reserved.
 *
 * The file tree represents the structure of the documentation as a three-level
 * tree.  This structure is generated by walking over the documentation source.
 *)

structure FileTree : sig

  (* meta data extracted from the attributes *)
    type meta = {
	author : string option,	(* value of "author" attribute *)
	kws : string list,	(* value of "keywords" attribute *)
	title : string option	(* alternate title to use in document header *)
      }

  (* a node in the file tree; the `info` field is used to distinguish the kind
   * of node (root, library, or page).
   *)
    datatype 'a file = FILE of {
	dir : string,		(* directory relative to the root of the documentation *)
	stem : string,		(* file-name stem; e.g., "json-lib" *)
	title : string,		(* title of page *)
	meta : meta,		(* meta data from attributes *)
	info : 'a		(* information specific to the type of file in the tree *)
      }

    datatype page_kind = SigPage | StructPage | FunctPage | OtherPage

  (* the leaves of the tree are the pages that describe the modules *)
    type page = {
	kind : page_kind,	(* specifies the kind of the main module
				 * or `OtherPage` for other material.
				 *)
	name : string		(* the main module name or page title *)
      } file

  (* the interior nodes correspond to libraries.  The info describes the pages
   * that comprise the library's documentation.
   *)
    type library = {
	pages : page list	(* list of manual pages for library *)
      } file

  (* the root file of the documentation; the info is the list of libraries *)
    type t = {libs : library list} file

  (* test equality by name *)
    val same : 'a file * 'a file -> bool

  (* is a page in a library? *)
    val inLibrary : library -> page -> bool

  (* get various components of a tree node *)
    val getAuthor : 'a file -> string option
    val getKeywords : 'a file -> string list
    val getAltTitle : 'a file -> string option
    val getDir : 'a file -> string
    val getStem : 'a file -> string
    val getTitle : 'a file -> string
    val getLibs : t -> library list
    val getPages : library -> page list

  (* apply the functions to the nodes of the tree *)
    val app : {
	    root : t -> unit,
	    lib : t * library -> unit,
	    page : t * library * page -> unit
	  } -> t -> unit

  (* do a walk over the tree; for interior nodes (root and libraries),
   * the function is called with "true" on entry and with "false" after
   * visiting the node's kids.
   *)
    val walk : {
	    root : bool * t -> unit,
	    lib : bool * t * library -> unit,
	    page : t * library * page -> unit
	  } -> t -> unit

  (* convert between JSON objects and the file tree datatypes *)
    val fromJSON : JSON.value -> t
    val toJSON : t -> JSON.value

  end = struct

    structure U = JSONUtil

  (* meta data extracted from the attributes *)
    type meta = {
	author : string option,	(* value of "author" attribute *)
	kws : string list,	(* value of "keywords" attribute *)
	title : string option	(* alternate title to use in document header *)
      }

    datatype 'a file = FILE of {
	dir : string,		(* directory relative to the root of the documentation *)
	stem : string,		(* file-name stem; e.g., "json-lib" *)
	title : string,		(* title of page *)
	meta : meta,		(* meta data from attributes *)
	info : 'a		(* information specific to the type of file in the tree *)
      }

    datatype page_kind = SigPage | StructPage | FunctPage | OtherPage

  (* the leaves of the tree are the pages that describe the modules *)
    type page = {
	kind : page_kind,	(* specifies the kind of the main module
				 * or `OtherPage` for other material.
				 *)
	name : string		(* the main module name or page title *)
      } file

  (* the interior nodes correspond to libraries.  The info describes the pages
   * that comprise the library's documentation.
   *)
    type library = {
	pages : page list	(* list of manual pages for library *)
      } file

  (* the root file of the documentation; the info is the list of libraries *)
    type t = {libs : library list} file

  (* test equality by name *)
    fun same (FILE f1, FILE f2) = (#dir f1 = #dir f2) andalso (#stem f1 = #stem f2)

  (* is a page in a library? *)
    fun inLibrary (FILE lib) (FILE p) = (#dir lib = #dir p)

  (* get various components of a tree node *)
    fun getAuthor (FILE{meta={author, ...}, ...}) = author
    fun getKeywords (FILE{meta={kws, ...}, ...}) = kws
    fun getAltTitle (FILE{meta={title, ...}, ...}) = title
    fun getDir (FILE{dir, ...}) = dir
    fun getStem (FILE{stem, ...}) = stem
    fun getTitle (FILE{title, ...}) = title
    fun getLibs (FILE{info={libs}, ...}) = libs
    fun getPages (FILE{info={pages}, ...}) = pages

    fun inLibrary (FILE lib) (FILE p) = (#dir lib = #dir p)

    fun app {root, lib, page} (ft : t) = let
	  fun walkLib (l : library) = (
		lib (ft, l);
		List.app (fn p => page(ft, l, p)) (getPages l))
	  in
	    root ft;
	    List.app walkLib (getLibs ft)
	  end

    fun walk {root, lib, page} (ft : t) = let
	  fun walkLib (l : library) = (
		lib (true, ft, l);
		List.app (fn p => page(ft, l, p)) (getPages l);
		lib (false, ft, l))
	  in
	    root (true, ft);
	    List.app walkLib (getLibs ft);
	    root (false, ft)
	  end

    datatype value = datatype JSON.value

    fun fromJSON root = let
	  fun jsonToMeta findField = {
		  author = (case findField "meta-author"
		     of NONE => NONE
		      | SOME NULL => NONE
		      | SOME obj => SOME(U.asString obj)
		    (* end case *)),
		  kws = (case findField "meta-keywords"
		     of NONE => []
		      | SOME NULL => []
		      | SOME kws => U.arrayMap U.asString kws
		    (* end case *)),
		  title = (case findField "meta-title"
		     of NONE => NONE
		      | SOME NULL => NONE
		      | SOME obj => SOME(U.asString obj)
		    (* end case *))
		}
	  fun jsonToFile obj getInfo = let
		val get = U.lookupField obj
		val find = U.findField obj
		in
		  FILE{
		      dir = U.asString(get "dir"),
		      stem = U.asString(get "stem"),
		      title = U.asString(get "title"),
		      meta = jsonToMeta find,
		      info = getInfo (get, find)
		    }
		end
	  fun jsonToPage obj = jsonToFile obj (fn (_, find) => (
		case (find "kind", find "name")
		 of (SOME k, SOME n) => let
		      val kind = (case U.asString k
			     of "signature" => SigPage
			      | "structure" => StructPage
			      | "functor" => FunctPage
			      | "other" => OtherPage
			      | s => raise Fail(concat["unknown page kind \"", s, "\""])
			    (* end case *))
		      in
			{kind = kind, name = U.asString n}
		      end
		  | _ => raise Fail "misformed page"
		(* end case *)))
	  fun jsonToLib obj = jsonToFile obj (fn (get, find) => {
		  pages = U.arrayMap jsonToPage (get "pages")
		})
	  in
	    jsonToFile root (fn (get, _) => {
		libs = U.arrayMap jsonToLib (get "libraries")
	      })
	  end

    fun toJSON root = let
	  fun metaToJSON (meta : meta, fields) = let
		val fields = (case #title meta
		       of NONE => fields
			| SOME s => ("meta-title", STRING s) :: fields
		      (* end case *))
		val fields = (case #kws meta
		       of [] => fields
			| kws => ("meta-keywords", ARRAY(List.map STRING kws)) :: fields
		      (* end case *))
		val fields = (case #author meta
		       of NONE => fields
			| SOME s => ("meta-author", STRING s) :: fields
		      (* end case *))
		in
		  fields
		end
	  fun fileToJSON (FILE{dir, stem, title, meta, info}) infoToJSON = let
		val fields = infoToJSON info
		val fields = metaToJSON (meta, fields)
		in
		  OBJECT(
		    ("dir", STRING dir) ::
		    ("stem", STRING stem) ::
		    ("title", STRING title) ::
		    fields)
		end
	  fun pageToJSON page = let
		fun infoToJSON {kind, name} = let
		      val kind = (case kind
			     of SigPage => "signature"
			      | StructPage => "structure"
			      | FunctPage => "functor"
			      | OtherPage => "other"
			    (* end case *))
		      in
			[("kind", STRING kind), ("name", STRING name)]
		      end
		in
		  fileToJSON page infoToJSON
		end
	  fun libToJSON lib = fileToJSON lib
		(fn _ => [("pages", ARRAY(map pageToJSON (getPages lib)))])
	  in
	    fileToJSON root
	      (fn {libs} => [("libraries", ARRAY(map libToJSON libs))])
	  end

  end
