import "xml.q"
import_dtd
  (namespace = "http://www.w3.org/1999/xhtml")
  "xhtml1-transitional.dtd"

namespace = "http://www.w3.org/1999/xhtml"

type heading = h1 | h2 | h3 | h4 | h5 | h6
type blocktext = pre | hr | blockquote | address | center | noframes
type lists = ul | ol | dl | menu | dir
type block = p | heading | div | lists | blocktext | isindex | fieldset | table 
type misc = ins | del | script | noscript
type Block = (block | form | misc)*

type Inline = (String | inline | misc)*
type inline = a | special | fontstyle | phrase | inline_forms
type special = br | span | bdo | object | applet | img | map |iframe
type fontstyle = tt | i | b | big | small | u | s | strike | font | basefont
type phrase = em | strong | dfn | code | q | sub | sup |
              samp | kbd | var | cite | abbr | acronym
type inline_forms = input | select | textarea | label | button

fun do_body (val arg as body) : String =
  match arg with
    body[AnyAttrs, val f as AnyElms] ->
      do_Flow(f)

fun do_html (val arg as html) : String =
  match arg with
    html[AnyAttrs,
	 val h as head,
    	 val b as body] -> 
      "\\documentclass{article}\n" ^
      do_head(h) ^
      "\\begin{document}\n\\maketitle\n" ^
      do_body(b) ^
      "\\end{document}\n"

fun do_head (val arg as head) : String =
  match arg with
    head[AnyAttrs,
	 AnyElms,
    	 title[AnyAttrs, val t as AnyElms],
    	 AnyElms] ->
      "\\title{" ^ strcat(t) ^ "}\n\\author{}\n\\date{Auto-generated by html2latex}\n"

fun strcat (val arg as String* ) : String =
  match arg with
    val x as String, val rest -> x ^ strcat(rest)
  | () -> ""

fun do_Block (val arg as Block) : String =
  match arg with
    val b as block, val rest -> do_block(b) ^ do_Block(rest)
  | (form | misc), val rest -> do_Block(rest)
  | () -> ""

fun do_block (val arg as block) : String =
  match arg with
    p[AnyAttrs, val i as AnyElms] -> do_Inline(i)
  | val h as heading -> do_heading(h)
  | ul[AnyAttrs, val l as AnyElms] -> do_ul_content(l) 
  | ol[AnyAttrs, val l as AnyElms] -> do_ol_content(l)
  | dl[AnyAttrs, val l as AnyElms] -> do_dl_content(l)
  | val t as table -> do_table(t)
  | val bt as blocktext -> do_blocktext(bt)
  | AnyElm -> ""

fun do_blocktext (val arg as blocktext) : String =
  match arg with
    center[AnyAttrs, val f as AnyElms] ->
      "\\begin{center}\n" ^ do_Flow(f) ^ "\\end{center}\n"
  | blockquote[AnyAttrs, val f as AnyElms] -> 
      do_Flow(f)
  | pre[AnyAttrs, val f as AnyElms] -> 
      do_Flow(f)
  | AnyElm ->
      ""

fun do_Inline (val arg as Inline) : String =
  match arg with
    val s as String, val rest ->
      (s) ^
      do_Inline(rest)
  | val i as inline, val rest ->
      do_inline(i) ^
      do_Inline(rest)
  | misc, val rest ->
      do_Inline(rest)
  | Any ->
      ""

fun do_inline (val arg as inline) : String =
  match arg with
    a[AnyAttrs, val ac as AnyElms] -> do_a_content(ac)
  | val fs as fontstyle -> do_fontstyle(fs)
  | val p as phrase -> do_phrase(p)
  | img[@alt[val s as AnyElms], @^alt[Any]*] -> strcat(s)
  | AnyElm -> ""

type a_content = (String | special | fontstyle | phrase | inline_forms | misc)*

fun do_a_content (val arg as a_content) : String =
  match arg with
    val s as String, val rest  as AnyElms->
      s ^
      do_a_content(rest)
  | val i as (special | fontstyle | phrase | inline_forms), val rest  as AnyElms->
      do_inline(i) ^			(* Here, we use subtyping effectively!! *)
      do_a_content(rest)
  | AnyElm, val rest  as AnyElms->
      do_a_content(rest)
  | () ->
      ""
  
fun do_heading (val arg as heading) : String =
  match arg with
    h1[AnyAttrs, val i as AnyElms] -> ("\\section{") ^ do_Inline(i) ^ ("}\n")
  | h2[AnyAttrs, val i as AnyElms] -> ("\\subsection{") ^ do_Inline(i) ^ ("}\n")
  | h3[AnyAttrs, val i as AnyElms] -> ("\\subsubsection{") ^ do_Inline(i) ^ ("}\n")
  | h4[AnyAttrs, val i as AnyElms] -> ("\\subsubsubsection{") ^ do_Inline(i) ^ ("}\n")
  | h5[AnyAttrs, val i as AnyElms] -> ("\\subsubsubsubsection{") ^ do_Inline(i) ^ ("}\n")
  | h6[AnyAttrs, val i as AnyElms] -> ("\\subsubsubsubsubsection{") ^ do_Inline(i) ^ ("}\n")

fun do_fontstyle (val arg as fontstyle) : String =
  match arg with
    tt[AnyAttrs, val i as AnyElms] -> ("{\\tt ") ^ do_Inline(i) ^ ("}")
  | i[AnyAttrs, val i as AnyElms] -> ("{\\it ") ^ do_Inline(i) ^ ("}")
  | b[AnyAttrs, val i as AnyElms] -> ("{\\bf ") ^ do_Inline(i) ^ ("}")
  | big[AnyAttrs, val i as AnyElms] -> ("{\\big ") ^ do_Inline(i) ^ ("}")
  | small[AnyAttrs, val i as AnyElms] -> ("{\\small ") ^ do_Inline(i) ^ ("}")
  | u[AnyAttrs, val i as AnyElms] -> do_Inline(i)
  | s[AnyAttrs, val i as AnyElms] -> do_Inline(i)
  | strike[AnyAttrs, val i as AnyElms] -> do_Inline(i)
  | font[AnyAttrs, val i as AnyElms] -> do_Inline(i)
  | basefont[AnyAttrs, val i as AnyElms] -> do_Inline(i)

fun do_phrase (val arg as phrase) : String =
  match arg with
    em[AnyAttrs, val i as AnyElms] -> ("{\\em ") ^ do_Inline(i) ^ ("}")
  | strong[AnyAttrs, val i as AnyElms] -> ("{\\em ") ^ do_Inline(i) ^ ("}")
  | dfn[AnyAttrs, val i as AnyElms] -> ("{\\em ") ^ do_Inline(i) ^ ("}")
  | code[AnyAttrs, val i as AnyElms] -> ("{\\tt ") ^ do_Inline(i) ^ ("}")
  | q[AnyAttrs, val i as AnyElms] -> ("{\\it ") ^ do_Inline(i) ^ ("}")
  | sub[AnyAttrs, val i as AnyElms] -> ("\\(_{\\mbox{") ^ do_Inline(i) ^ ("}}\\)")
  | sup[AnyAttrs, val i as AnyElms] -> ("\\(^{\\mbox{") ^ do_Inline(i) ^ ("}}\\)")
  | samp[AnyAttrs, val i as AnyElms] -> ("{\\em ") ^ do_Inline(i) ^ ("}")
  | kbd[AnyAttrs, val i as AnyElms] -> ("{\\tt ") ^ do_Inline(i) ^ ("}")
  | var[AnyAttrs, val i as AnyElms] -> ("\\(") ^ do_Inline(i) ^ ("\\)")
  | cite[AnyAttrs, val i as AnyElms] -> ("{\\em ") ^ do_Inline(i) ^ ("}")
  | abbr[AnyAttrs, val i as AnyElms] -> ("{\\em ") ^ do_Inline(i) ^ ("}")
  | acronym[AnyAttrs, val i as AnyElms] -> ("{\\em ") ^ do_Inline(i) ^ ("}")

type Flow = (String | block | form | inline | misc)*

fun do_ul_content (val arg as li+) : String =
  match arg with
    val l  as AnyElms-> 
      ("\\begin{itemize}\n") ^ 
      do_lis(l) ^ 
      ("\\end{itemize}\n")

fun do_ol_content (val arg as li+) : String =
  match arg with
    val l -> 
      ("\\begin{enumerate}\n") ^ 
      do_lis(l) ^ 
      ("\\end{enumerate}\n")

fun do_lis (val arg as li+) : String =
  match arg with
    li[AnyAttrs, val f as AnyElms] -> 
      ("\\item ") ^ do_Flow(f) ^ ("\n")
  | li[AnyAttrs, val f as AnyElms], val rest -> 
      ("\\item ") ^ do_Flow(f) ^ ("\n") ^ do_lis(rest)

fun do_Flow (val arg as Flow) : String =
  match arg with
    val s as String, val rest  as AnyElms-> (s) ^ do_Flow(rest)
  | val b as block, val rest  as AnyElms-> do_block(b) ^ do_Flow(rest)
  | val i as inline, val rest  as AnyElms-> do_inline(i) ^ do_Flow(rest)
  | (form | misc), val rest  as AnyElms-> do_Flow(rest)
  | () -> ""

fun do_dl_content (val arg as (dt|dd)+) : String =
  match arg with
    val l -> 
      ("\\begin{description}\n") ^ 
      do_ds(l) ^ 
      ("\\end{description}\n")

fun do_ds (val arg as (dt|dd)* ) : String =
  match arg with
    () ->
      ""
  | val dts as dt*, val dds as dd, val rest ->
      "\\item[" ^ cat_dts(dts) ^ "] " ^
      cat_dds(dds) ^ "\n" ^
      do_ds(rest)
  | val dts as dt* ->
      "\\item[" ^ cat_dts(dts) ^ "]\n" 

fun cat_dts (val arg as dt* ) : String =
  match arg with
    () ->
      ""
  | dt[AnyAttrs, val i as AnyElms] ->
      do_Inline(i)
  | dt[AnyAttrs, val i as AnyElms], val rest ->
      do_Inline(i) ^ ", " ^ cat_dts(rest)

fun cat_dds (val arg as dd* ) : String =
  match arg with
    () ->
      ""
  | dd[AnyAttrs, val f as AnyElms] ->
      do_Flow(f)
  | dd[AnyAttrs, val f as AnyElms], val rest ->
      do_Flow(f) ^ ", " ^ cat_dds(rest)

fun do_table (val arg as table) : String = ""

fun main () : () =
  match argv() with
    val infile as String, val outfile as String ->
      let val file = load_xml(infile) in
      let val html = validate file with html in
      let val s = do_html(html) in
      fileout_string(outfile)(s)
  | Any ->
      print("Usage: <xduce-program> html2latex.q -- <input-file> <output-file>")

let val Any = main()