/** -*-C-*-ish
    ElementTree.k Copyright (C) 2005 Chris Morris

    This file is distributed under the terms of the GNU Lesser General
    Public Licence. See COPYING for licence.
*/
"<summary>Manipulation of ElementTrees</summary>
<prose>This module contains functions for manipulating HTML or XML element trees described by <dataref>ElementTreeData::ElementTree</dataref>, including conversion to and from Strings, and a basic templating system.</prose>"
module ElementTree;

import Prelude;
import Regex;
import Strings;
import Dict;
import Set;
import public ElementTreeData;
import XMLentities;

data StartTagType = BlackListed | Empty(ElementTree e)
     | ImplicitCloser | NormalOpen(ElementTree o)
     | TemplateFn(ElementTree() fn);

"<argument>The String contains error details</argument>
<summary>Input error parsing XML</summary>
<prose>An error occurred while importing an XML string.</prose>
<related><functionref>elementTree</functionref></related>"
Exception InputError(String s);
"<argument>The String contains the position of the error</argument>
<summary>Unexpected end of data parsing XML</summary>
<prose>The XML string unexpectedly ended while trying to import.</prose>
<related><functionref>elementTree</functionref></related>"
Exception UnexpectedEnd(String p);
"<argument>The Char contains the character expected, and the String contains the position of the error</argument>
<summary>Expected character missing parsing XML</summary>
<prose>An expected character was not present when parsing XML.</prose>
<related><functionref>elementTree</functionref></related>"
Exception ExpectedChar(Char c, String p);
"<argument>The Char contains the unexpected character, and the String contains the position of the error</argument>
<summary>Unexpected character found parsing XML</summary>
<prose>An unexpected character was found when parsing XML.</prose>
<related><functionref>elementTree</functionref></related>"
Exception UnexpectedChar(Char c, String p);
"<summary>The item to evaluate is not a generator</summary>
<prose>This Exception is thrown if the item being evaluated is not a generator (so instead is a normal sub-element or text block).</prose>
<related><functionref>evaluateGenerator</functionref></related>"
Exception NotLazy();

foreign "stdfuns.o" {
  // PRIVATE utility function for doing string operations when we
  // already know we're in bounds
    pure Char unsafeIndex(String s, Int i) = getIndex;
    String do_unsafeSubstr(Ptr vm, String x, Int i, Int len) = getsubstr;
    Int offsetFirstOccurs(Char c, String str, Int i) = offset_wcscspn;
}

String unsafeSubstr(String x, Int i, Int len) = do_unsafeSubstr(getVM,x,i,len);

"<argument name='etree'>The ElementTree to convert to a String</argument>
<argument name='mode'>How to print empty tags (see <dataref>ElementTreeData::EmptyTagMode</dataref>). Optional, defaulting to <code>OpenAndClose</code>.</argument>
<argument name='indentlevel'>The initial indentation level to use. Optional, defaulting to zero.</argument>
<argument name='uform'>The method of printing non-ASCII characters (see <dataref>ElementTreeData::UnicodeFormat</dataref>). Optional, defaulting to <code>LiteralUTF8</code>.</argument>
<argument name='breakers'>A dictionary of elements that start a new line in the output code. Optional, defaulting to an empty dictionary</argument>
<argument name='emptyels'>A dictionary of elements that are empty. Optional, defaulting to an empty dictionary</argument>
<summary>Convert an ElementTree to a String</summary>
<prose>Convert an ElementTree to a String, using the selected  conversion options. If the String will be printed immediately, use <functionref>lazyPrint</functionref> instead.</prose>
<related><functionref>lazyPrint</functionref></related>"
public String string(ElementTree etree, EmptyTagMode mode = OpenAndClose, Int indentlevel = 0, UnicodeFormat uform = LiteralUTF8, HashSet<String> breakers=newHashSet(1,strHash), HashSet<String> emptyels=newHashSet(1,strHash)) {
  output = "";
  indents = makeIndents();
  void(doToString(output,etree,mode,indentlevel,uform,breakers,emptyels,indents));
  return output;
}

// false for nobreak, true otherwise
Bool format(HashSet<String> formats, String name) = elem(name,formats);

// recursively does things with the string
Bool doToString(var String output, ElementTree etree, EmptyTagMode mode = OpenAndClose, Int indentlevel = 0, UnicodeFormat uform = LiteralUTF8, HashSet<String> breakers=newHashSet(1,strHash), HashSet<String> emptyels=newHashSet(1,strHash), var [String] indents) {
  elformat = format(breakers,etree.name);
  if (elformat) {
    output += getIndent(indents,indentlevel);
  }
  if (size(etree.elements) > 0 || mode == OpenAndClose) {
    output += startTag(etree,uform);
    lastse = false;
    for element in etree.elements {
      case element of {
	// either it's a sub-element
	SubElement(nested) -> lastse = doToString(output,nested,mode,indentlevel+1,uform,breakers,emptyels,indents);
	// or it's text (which can't contain tags...)
	| CData(cdata) -> lastse = false;
	  // don't need to encode quotes here.
	  output += simpleEncode(cdata,true,uform);
	  // or it's for lazy evaluation and will be a sub-element
	| SubTree(generator) -> lastse = lazyString(output,@generator,mode,indentlevel,uform,breakers,emptyels,indents); 
      }
    }
    if (elformat && lastse) {
      output += getIndent(indents,indentlevel);
    }
    output += endTag(etree);
  } else {
    // if it contains nothing, and the parse mode is appropriate,
    // assume it's an empty tag.
    if (elem(etree.name,emptyels)) {
      output += singletonTag(etree,mode,uform);
    } else {
      // then we need to explicitly open and close it
      output += startTag(etree,uform)+endTag(etree);      
    }
  }
  //  gc();
  return elformat;
}

Bool lazyString(var String output, ElementTree() generator, EmptyTagMode mode = OpenAndClose, Int indentlevel = 0, UnicodeFormat uform = LiteralUTF8, HashSet<String> breakers=newHashSet(1,strHash), HashSet<String> emptyels=newHashSet(1,strHash), var [String] indents) {
  return doToString(output,generator(),mode,indentlevel+1,uform,breakers,emptyels,indents);
}

"<argument name='etree'>The ElementTree to print</argument>
<argument name='mode'>How to print empty tags (see <dataref>ElementTreeData::EmptyTagMode</dataref>). Optional, defaulting to <code>OpenAndClose</code>.</argument>
<argument name='indentlevel'>The initial indentation level to use. Optional, defaulting to zero.</argument>
<argument name='uform'>The method of printing non-ASCII characters (see <dataref>ElementTreeData::UnicodeFormat</dataref>). Optional, defaulting to <code>LiteralUTF8</code>.</argument>
<argument name='breakers'>A dictionary of elements that start a new line in the output code. Optional, defaulting to an empty dictionary</argument>
<argument name='emptyels'>A dictionary of elements that are empty. Optional, defaulting to an empty dictionary</argument>
<argument name='outfn'>A function to output strings</argument>
<summary>Print an ElementTree to a user-defined target</summary>
<prose>Print an ElementTree to the target of <variable>outfn</variable>, using the selected conversion options.</prose>
<related><functionref>lazyPrint</functionref></related>
<related><functionref>string</functionref></related>"
public Void lazyOutput(ElementTree etree, EmptyTagMode mode = OpenAndClose, Int indentlevel = 0, UnicodeFormat uform = LiteralUTF8, HashSet<String> breakers=newHashSet(1,strHash), HashSet<String> emptyels=newHashSet(1,strHash), Void(String) outfn) {
  indents = makeIndents();
  void(doLazyOutput(etree,mode,indentlevel,uform,breakers,emptyels,indents,outfn));
}

"<argument name='etree'>The ElementTree to print</argument>
<argument name='mode'>How to print empty tags (see <dataref>ElementTreeData::EmptyTagMode</dataref>). Optional, defaulting to <code>OpenAndClose</code>.</argument>
<argument name='indentlevel'>The initial indentation level to use. Optional, defaulting to zero.</argument>
<argument name='uform'>The method of printing non-ASCII characters (see <dataref>ElementTreeData::UnicodeFormat</dataref>). Optional, defaulting to <code>LiteralUTF8</code>.</argument>
<argument name='breakers'>A dictionary of elements that start a new line in the output code. Optional, defaulting to an empty dictionary</argument>
<argument name='emptyels'>A dictionary of elements that are empty. Optional, defaulting to an empty dictionary</argument>
<summary>Print an ElementTree</summary>
<prose>Print an ElementTree to standard output, using the selected conversion options.</prose>
<related><functionref>lazyOutput</functionref></related>
<related><functionref>string</functionref></related>"
public Void lazyPrint(ElementTree etree, EmptyTagMode mode = OpenAndClose, Int indentlevel = 0, UnicodeFormat uform = LiteralUTF8, HashSet<String> breakers=newHashSet(1,strHash), HashSet<String> emptyels=newHashSet(1,strHash)) {
  indents = makeIndents();
  void(doLazyPrint(etree,mode,indentlevel,uform,breakers,emptyels,indents));
}

Bool doLazyPrint(ElementTree etree, EmptyTagMode mode = OpenAndClose, Int indentlevel = 0, UnicodeFormat uform = LiteralUTF8, HashSet<String> breakers=newHashSet(1,strHash), HashSet<String> emptyels=newHashSet(1,strHash), [String] indents) {
  elformat = format(breakers,etree.name);
  if (elformat) {
    putStr(getIndent(indents,indentlevel));
  }
  if (size(etree.elements) > 0) {
    putStr(startTag(etree,uform));
    lastse = false;
    if (elformat) {
      ninlevel = indentlevel+1;
    } else {
      ninlevel = indentlevel;
    }
    for element in etree.elements {
      case element of {
	SubElement(nested) -> lastse = doLazyPrint(nested,mode,ninlevel,uform,breakers,emptyels,indents);
	| CData(cdata) -> lastse = false;
	putStr(simpleEncode(cdata,true,uform));
	| SubTree(generator) -> lastse = doLazyPrint(generator(),mode,ninlevel,uform,breakers,emptyels,indents); //gc();
      }
    }
    
    if (elformat && lastse) {
      putStr(getIndent(indents,indentlevel));
    }
    putStr(endTag(etree));
  } else {
    if (elem(etree.name,emptyels) && mode != OpenAndClose) {
      putStr(singletonTag(etree,mode,uform));
    } else {
      putStr(startTag(etree,uform));
      putStr(endTag(etree));      
    }
  }
  return elformat;
}

Bool doLazyOutput(ElementTree etree, EmptyTagMode mode = OpenAndClose, Int indentlevel = 0, UnicodeFormat uform = LiteralUTF8, HashSet<String> breakers=newHashSet(1,strHash), HashSet<String> emptyels=newHashSet(1,strHash), [String] indents, Void(String) outfn) {
  elformat = format(breakers,etree.name);
  if (elformat) {
    outfn(getIndent(indents,indentlevel));
  }
  if (size(etree.elements) > 0) {
    outfn(startTag(etree,uform));
    lastse = false;
    if (elformat) {
      ninlevel = indentlevel+1;
    } else {
      ninlevel = indentlevel;
    }
    for element in etree.elements {
      case element of {
	SubElement(nested) -> lastse = doLazyOutput(nested,mode,ninlevel,uform,breakers,emptyels,indents,outfn);
	| CData(cdata) -> lastse = false;
	outfn(simpleEncode(cdata,true,uform));
	| SubTree(generator) -> lastse = doLazyOutput(generator(),mode,ninlevel,uform,breakers,emptyels,indents,outfn); //gc();
      }
    }
    
    if (elformat && lastse) {
      outfn(getIndent(indents,indentlevel));
    }
    outfn(endTag(etree));
  } else {
    if (elem(etree.name,emptyels) && mode != OpenAndClose) {
      outfn(singletonTag(etree,mode,uform));
    } else {
      outfn(startTag(etree,uform));
      outfn(endTag(etree));      
    }
  }
  return elformat;
}


// this looks a bit silly, but it's more efficient than calling rep()
// every time.
[String] makeIndents() = ["\n",
			  "\n ",
			  "\n  ",
			  "\n   ",
			  "\n    ",
			  "\n     ",
			  "\n      ",
			  "\n       ",
			  "\n        "]; // have some in to start with

String getIndent(var [String] indents, Int level) {
  i = indents[level];
  if (isInitialised(i)) {
    return i;
  }
  // because it can only increase one at a time
  i = indents[level-1]+" ";
  return i;
}

private String startTag(ElementTree etree, UnicodeFormat uform) = openTag(etree,uform)+">";

private String endTag(ElementTree etree) = "</"+etree.name+">";

private String singletonTag(ElementTree etree, EmptyTagMode mode, UnicodeFormat uform) {
  output = openTag(etree,uform);
  case mode of {
    ImpliedSingleton -> output += ">";
    | _ -> output += " />";
  }
  return output;
}

private String openTag(ElementTree etree, UnicodeFormat uform) {
  // this will need modification if we ever start on XML namespaces
  output = "<"+etree.name;

  // only more efficient for tinyDict
  names = keys(etree.attributes);
  values = vals(etree.attributes);
  for i in [0..size(names)-1] {
    /*    if (quickMatch("[^A-Za-z]",key) || key == "") {
      //      throw(ElementParseError);
      } */
    output += " " + names[i] + "=\"" + simpleEncode(values[i],false,uform) + "\"";
  }
  return output;
}

"<argument name='invalue'>The String to escape</argument>
<argument name='leavequotes'>Whether to leave quotes unescaped. This is optional and defaults to false (i.e. quotes will be escaped)</argument>
<argument name='uform'>If this is set to <code>NumericReference</code> (not the default) then non-ASCII characters will be replaced by numeric references.</argument>
<summary>HTML-escape a string</summary>
<prose>HTML-escape a string, so that &lt;, &gt;, &amp; and possibly &quot; are converted to their entity equivalents (&amp;lt;, &amp;gt;, &amp;amp; and &amp;quot; respectively).</prose>
<prose>This is automatically done to all element text content and attribute values when converting ElementTree to String - this function is provided for use in other contexts.</prose>"
public String simpleEncode(String invalue, Bool leavequotes=false, UnicodeFormat uform=LiteralUTF8) {
  if (invalue == "" || (!elem('&',invalue) &&
			(leavequotes || !elem('"',invalue)) &&
			!elem('<',invalue))) { return invalue; }
  value = copy(invalue);
  // here we rely on the incoming code being literal UTF8. It should be.
  replace("&","&amp;",value,[Global]);
  replace("<","&lt;",value,[Global]);
  //  replace(">","&gt;",value,[Global]); // unnecessary
  if (!leavequotes) {
    replace("\"","&quot;",value,[Global]);
  }
  // don't need to escape ' because we always use " to quote values
  case uform of {
    LiteralUTF8 -> return value;
    | NumericReference -> return literalToEntity(value);
  }
}

"<argument name='name'>The name of the new element</argument>
<argument name='expectedchildren'>This argument is used for optimising internal functions but may be useful to end users in some circumstances - it gives the expected number of child elements (including text data blocks). It is optional and defaults to 10.</argument>
<summary>Create a new element</summary>
<prose>Creates a new Element with the specified name.</prose>"
public ElementTree newElement(String name, Int expectedchildren=0) {
  // use Dict::newTiny because most elements have few attributes.
  if (expectedchildren > 0) {
    return ElementTree(createArray(expectedchildren),name,Dict::newTiny);
  } else {
    // 10 is probably a reasonable guess for most elements.
    return ElementTree(createArray(10),name,Dict::newTiny);
  }
}

public Int attrHash(String tohash) = Int(head(tohash));

"<argument name='parent'>The parent element</argument>
<argument name='child'>The child element</argument>
<summary>Add a new child element to the end</summary>
<prose>Adds a new child element to the end of the parent element.</prose>
<related><functionref>addElementAt</functionref></related>
<related><functionref>pushData</functionref></related>
<related><functionref>pushGenerator</functionref></related>
<related><functionref>unshiftElement</functionref></related>"
public Void pushElement(ElementTree parent, ElementTree child) {
  push(parent.elements,SubElement(child));
}

"<argument name='parent'>The parent element</argument>
<argument name='child'>The child element</argument>
<summary>Add a new child element to the start</summary>
<prose>Adds a new child element to the start of the parent element.</prose>
<related><functionref>addElementAt</functionref></related>
<related><functionref>unshiftData</functionref></related>
<related><functionref>unshiftGenerator</functionref></related>
<related><functionref>pushElement</functionref></related>"
public Void unshiftElement(ElementTree parent, ElementTree child) {
  unshift(SubElement(child),parent.elements);
}

"<argument name='parent'>The parent element</argument>
<argument name='child'>The child element</argument>
<argument name='index'>The index starting from zero</argument>
<summary>Add a new child element</summary>
<prose>Adds a new child element to the parent element at the specified index.</prose>
<related><functionref>addDataAt</functionref></related>
<related><functionref>addGeneratorAt</functionref></related>
<related><functionref>pushElement</functionref></related>
<related><functionref>unshiftElement</functionref></related>"
public Void addElementAt(ElementTree parent, ElementTree child, Int index) {
  addAt(parent.elements,SubElement(child),index);
}

"<argument name='parent'>The parent element</argument>
<argument name='child'>The child generator</argument>
<summary>Add a new child generator to the end</summary>
<prose>Adds a new child generator to the end of the parent element. This allows the element tree to be built up lazily saving memory.</prose>
<related><functionref>addGeneratorAt</functionref></related>
<related><functionref>pushData</functionref></related>
<related><functionref>pushElement</functionref></related>
<related><functionref>unshiftGenerator</functionref></related>"
public Void pushGenerator(ElementTree parent, ElementTree() child) {
  push(parent.elements,SubTree(@child));
}

"<argument name='parent'>The parent element</argument>
<argument name='child'>The child generator</argument>
<summary>Add a new child generator to the start</summary>
<prose>Adds a new child generator to the start of the parent element. This allows the element tree to be built up lazily saving memory.</prose>
<related><functionref>addGeneratorAt</functionref></related>
<related><functionref>pushGenerator</functionref></related>
<related><functionref>unshiftData</functionref></related>
<related><functionref>unshiftElement</functionref></related>"
public Void unshiftGenerator(ElementTree parent, ElementTree() child) {
  unshift(SubTree(@child),parent.elements);
}

"<argument name='parent'>The parent element</argument>
<argument name='child'>The child element</argument>
<argument name='index'>The index starting from zero</argument>
<summary>Add a new child generator</summary>
<prose>Adds a new child generator to the parent element at the specified index. This allows the element tree to be built up lazily saving memory.</prose>
<related><functionref>addDataAt</functionref></related>
<related><functionref>addElementAt</functionref></related>
<related><functionref>pushGenerator</functionref></related>
<related><functionref>unshiftGenerator</functionref></related>"
public Void addGeneratorAt(ElementTree parent, ElementTree() child, Int index) {
  addAt(parent.elements,SubTree(@child),index);
}

"<argument name='parent'>The parent element</argument>
<argument name='cdata'>The text to add</argument>
<summary>Add text to the end of an element</summary>
<prose>Adds the text to the end of the parent element. Adjacent text blocks will be merged.</prose>
<related><functionref>addDataAt</functionref></related>
<related><functionref>pushElement</functionref></related>
<related><functionref>pushGenerator</functionref></related>
<related><functionref>unshiftData</functionref></related>"
public Void pushData(ElementTree parent, String cdata) {
  if (size(parent.elements) == 0) {
    push(parent.elements,CData(cdata));
  } else {
    case parent.elements[size(parent.elements)-1] of {
      CData(text) -> parent.elements[size(parent.elements)-1].cdata += cdata;
      | _ -> push(parent.elements,CData(cdata));
    }
  }
}

"<argument name='parent'>The parent element</argument>
<argument name='cdata'>The text to add</argument>
<summary>Add text to the start of an element</summary>
<prose>Adds the text to the start of the parent element. Adjacent text blocks will be merged.</prose>
<related><functionref>addDataAt</functionref></related>
<related><functionref>pushData</functionref></related>
<related><functionref>unshiftElement</functionref></related>
<related><functionref>unshiftGenerator</functionref></related>"
public Void unshiftData(ElementTree parent, String cdata) {
  if (size(parent.elements) == 0) {
    unshift(CData(cdata),parent.elements);
  } else {
    case parent.elements[0] of {
      CData(text) -> parent.elements[0].cdata = cdata + parent.elements[0].cdata;
      | _ -> unshift(CData(cdata),parent.elements);
    }
  }
}

"<argument name='parent'>The parent element</argument>
<argument name='cdata'>The text to add</argument>
<argument name='index'>The index to add at</argument>
<summary>Add text to an element</summary>
<prose>Adds the text to the specified position in the parent element. If the preceding block is also a text block, they will be merged.</prose>
<related><functionref>addElementAt</functionref></related>
<related><functionref>addGeneratorAt</functionref></related>
<related><functionref>pushData</functionref></related>
<related><functionref>unshiftData</functionref></related>"
public Void addDataAt(ElementTree parent, String cdata, Int index) {
  if (index == 0) {
    unshiftData(parent,cdata);
  } else {
    case parent.elements[index-1] of {
      CData(text) -> parent.elements[index-1].cdata += cdata;
      | _ -> addAt(parent.elements,CData(cdata),index);
    }
  }
}

"<argument name='element'>The parent element</argument>
<argument name='idx'>The index to evaluate</argument>
<summary>Evaluate a lazy element generator</summary>
<prose>Evaluate a lazy element generator and replace it with its result. This can be useful if you need to further process the results before printing the element tree, or if you want to <moduleref>Pickle</moduleref> the element tree.</prose>"
public Void evaluateGenerator(ElementTree element, Int idx) {
  case element.elements[idx] of {
    SubTree(gen) -> element.elements[idx] = SubElement(gen());
    | _ -> throw(NotLazy);
  }
}

"<argument name='element'>The element</argument>
<argument name='name'>The attribute to set</argument>
<argument name='value'>The attribute value</argument>
<summary>Set an attribute</summary>
<prose>Set an element attribute, overwriting any existing value.</prose>
<related><functionref>getAttribute</functionref></related>
<related><functionref>getAttributes</functionref></related>
<related><functionref>unsetAttribute</functionref></related>"
public Void setAttribute(ElementTree element, String name, String value) {
  add(element.attributes,name,value);
}

"<argument name='element'>The element</argument>
<argument name='name'>The attribute to unset</argument>
<summary>Unset an attribute</summary>
<prose>Unset an element attribute.</prose>
<related><functionref>getAttribute</functionref></related>
<related><functionref>getAttributes</functionref></related>
<related><functionref>setAttribute</functionref></related>"
public Void unsetAttribute(ElementTree element, String name) {
  delete(element.attributes,name);
}

"<argument name='element'>The element</argument>
<summary>Get the text length of an element</summary>
<prose>Get the text length of an element's contents, including any text in sub-elements, but not the tags that delimit those elements. Items such as &lt; are shown in their unescaped form.</prose>
<prose>Note that any element generators inside the element will be evaluated as a result of this function, which may be very inefficient.</prose>"
public Int textSizeOfBlock(Element element) {
  case element of {
    CData(text) -> return length(text);
    | SubElement(el) -> len = 0;
    for elem in el.elements {
      len += textSizeOfBlock(elem);
    }
    return len;
    | SubTree(gen) -> el = gen(); // this can be really inefficient.
    for elem in el.elements {
      len += textSizeOfBlock(elem);
    }
    return len;
  }
}

"<argument name='block'>The parent element</argument>
<summary>Get all child elements</summary>
<prose>Get all child elements, whether they are sub trees, generators, or text blocks.</prose>
<related><functionref>getAttribute</functionref></related>
<related><functionref>getAttributes</functionref></related>
<related><functionref>getName</functionref></related>
<related><functionref>getSubtrees</functionref></related>"
public [Element] getElements(ElementTree block) {
  return block.elements;
}

"<argument name='block'>The element</argument>
<summary>Get an element name</summary>
<prose>Get the name of the element</prose>
<related><functionref>getAttribute</functionref></related>
<related><functionref>getAttributes</functionref></related>
<related><functionref>getElements</functionref></related>"
public String getName(ElementTree block) {
  return block.name;
}


"<argument name='block'>The element</argument>
<summary>Get an element's attributes</summary>
<prose>Gets the element's attributes</prose>
<related><functionref>getAttribute</functionref></related>
<related><functionref>getElements</functionref></related>
<related><functionref>getName</functionref></related>
<related><functionref>setAttribute</functionref></related>
<related><functionref>unsetAttribute</functionref></related>"
public TinyDict<String,String> getAttributes(ElementTree block) {
  return block.attributes;
}

"<argument name='block'>The element</argument>
<argument name='attribute'>The attribute</argument>
<summary>Get an attribute value from an element</summary>
<prose>Gets an attribute value from the element, or <code>nothing</code> if the element does not have that attribute.</prose>
<related><functionref>getAttributes</functionref></related>
<related><functionref>getElements</functionref></related>
<related><functionref>getName</functionref></related>
<related><functionref>setAttribute</functionref></related>
<related><functionref>unsetAttribute</functionref></related>"
public Maybe<String> getAttribute(ElementTree block, String attribute) {
  return lookup(block.attributes,attribute);
}

"<argument name='block'>The element</argument>
<argument name='subname'>The child element's name</argument>
<summary>Get the index of a named sub-element from an element</summary>
<prose>Gets the index of the first named sub-element within the parent element, or <code>nothing</code> if the element does not have a sub-element with that name.</prose>
<prose>Generators will be evaluated to see if their root element is the right element.</prose>"
public Maybe<Int> findElement(ElementTree block, String subname) {
  i=0;
  for e in block.elements {
    case e of {
      SubElement(el) -> if (el.name == subname) { return just(i); }
      | SubTree(gen) -> el = gen(); if (el.name == subname) { return just(i); }
      | _ -> ;
    }
    i++;
  }
  return nothing;
}

"<argument name='outer'>The parent element</argument>
<summary>Get all child element trees</summary>
<prose>Get all child element trees, excluding generators and text blocks.</prose>
<related><functionref>getElements</functionref></related>"
public [ElementTree] getSubtrees(ElementTree outer) {
  inner = [];
  for el in getElements(outer) {
    case el of {
      SubElement(etree) -> push(inner,etree);
      | _ -> ;
    }
  }
  return inner;
}

"<argument name='outer'>The element</argument>
<summary>Returns the text content of the element</summary>
<prose>Returns the text content of the element (excluding text in sub-elements)</prose>
<related><functionref>getAllText</functionref></related>
<related><functionref>textSizeOfBlock</functionref></related>"
public String getText(ElementTree outer) {
  inner = "";
  for el in getElements(outer) {
    case el of {
      CData(cd) -> inner += cd;
      | _ -> ;
    }
  }
  return inner;
}

"<argument name='outer'>The element</argument>
<summary>Returns the text content of the element and children</summary>
<prose>Returns the text content of the element (including text in sub-elements). Generators will be evaluated to calculate their text content.</prose>
<related><functionref>getText</functionref></related>
<related><functionref>textSizeOfBlock</functionref></related>"
public String getAllText(ElementTree outer) {
  inner = "";
  for el in getElements(outer) {
    case el of {
      CData(cd) -> inner += cd;
      | SubElement(tree) -> inner += getAllText(tree);
      | SubTree(gen) -> inner += getAllText(gen());
    }
  }
  return inner;
}

"<argument name='tree'>The element tree to be processed</argument>
<argument name='exempt'>A list of the names of elements exempted from being processed (for example, in HTML, the &lt;img> element is empty, but may not be appropriate for removal. If an exempt element contains empty elements, these elements will not be removed either.</argument>
<summary>Recursively remove empty elements</summary>
<prose>Recursively removes empty elements (i.e. elements that only contain other empty elements and whitespace) from an ElementTree. This function returns true if once this is done the current element is itself empty, false otherwise. Generators are not evaluated but are assumed to be non-empty.</prose>"
Bool stripEmpty(ElementTree tree, [String] exempt=createArray(1)) {
  rms = [];
  isempty = true;
  for el@i in getElements(tree) {
    case el of {
      SubElement(n) -> if (!elem(n.name,exempt) && stripEmpty(n)) {
	unshift(i,rms);
      } else {
	isempty = false;
      }
      | CData(c) -> if (quickMatch("\\S",c)) {
	isempty = false;
      } else {
	unshift(i,rms);
      }
      | _ -> isempty = false;
    }
  }
  for rm in rms {
    removeAt(tree.elements,rm);
  }
  
  return isempty;
}


/* Start of String->ElementTree conversion functions */

// private data type for caching
data Original (String str, Int len);

data ConvertOpts(Dict<String,[String]> whitelist,
		 Dict<String,[String]> implicitend,
		 [String] emptyels,
		 Dict<String,ElementTree([(String,String)])> templates,
		 Bool wlempty,
		 Bool ieempty,
		 Bool tmempty,
		 Bool casesen,
		 Bool sloppy);

"<argument name='original'>The String to convert</argument>
<argument name='rootelement'>The name of the root element to use as a parent. Optional, defaulting to \"tree\".</argument>
<argument name='whitelist'>A whitelist dictionary of allowed elements. The key is the element name, the value is a list of allowed attribute names for that element. If the key is \"*\" then all elements are allowed (though you may wish to explicitly specify others to override the attributes specified for \"*\"). If the value list contains \"*\" then all attributes are allowed. Optional, defaulting to the empty dictionary, which makes this function strip all tags from the string as it imports it.</argument>
<argument name='implicitend'>A dictionary of tags that close elements other than their own. In XML, this should be an empty dictionary - it is used to parse HTML and other SGML dialects that allow implicit closing. The key is the element to close, and the value is a list of tags that will close that element, represented as <variable>\"tagname\"</variable> for an opening tag, and <variable>\"/tagname\"</variable> for a closing tag. For example, the implicit ending list for the \"li\" element in HTML is <code>[\"li\",\"/ul\",\"/ol\"]</code>. This is optional and defaults to the empty dictionary, which is correct for XML strings.</argument>
<argument name='emptyels'>A list of elements that are allowed to be empty (i.e. a singleton tag such as &lt;br> is allowed). This is very important when importing HTML or other SGML dialects where a singleton tag might not differ in appearance from a normal opening tag. This is optional and defaults to the empty list. When processing XML, this list should always be empty, as it is never ambiguous.</argument>
<argument name='templates'>A dictionary of elements that are really calls to templating functions. The key is the element name, and the value is a function that takes a list of pairs of attributes and returns an <code>ElementTree</code>. This can be used for templating, or for converting one form of XML into another. This is optional and defaults to the empty dictionary.</argument>
<argument name='casesensitive'>Should conversion be case-sensitive? If this is false, all <code>whitelist</code>, <code>implicitend</code>, <code>emptyels</code> and <code>templates</code> keys and values will be treated as case-insensitive, and all elements will be converted to lowercase. In XML, this should be set to true, which will give some increase in processing speed. This parameter is optional and the default value is false.</argument>
<argument name='sloppy'>Use 'sloppy' processing, which attempts to make a reasonable guess at the meaning of broken input. It may guess entirely wrongly, of course, and in some circumstances it may still throw an Exception. Optional, defaulting to false (where it should be left if possible!). This argument is ignored if the <code>templates</code> dictionary has any contents.</argument>
<summary>Converts a String to an ElementTree.</summary>
<prose>Converts a String to an ElementTree. Several additional parameters may
be passed to control various aspects of the conversion.</prose>
<related><functionref>string</functionref></related>"
// case sensitive is twice as fast sometimes!
public ElementTree elementTree(String original,
			       String rootelement="tree",
			       Dict<String,[String]> whitelist=Dict::new(2,strHash),
			       Dict<String,[String]> implicitend=Dict::new(2,strHash),
			       [String] emptyels=createArray(1),
			       Dict<String,ElementTree([(String,String)])> templates=Dict::new(2,strHash),
			       Bool casesensitive=false,
			       Bool sloppy=false) {

  tree = newElement(rootelement);
  pos = 0;
  len = length(original);
  if (!empty(templates)) {
    sloppy = false;
  }
  if (casesensitive) {
    opts = ConvertOpts(whitelist,implicitend,emptyels,templates,empty(whitelist),empty(implicitend),empty(templates),true,sloppy);
  } else {
    opts = ConvertOpts(lowerDict(whitelist),lowerDict(implicitend),emptyels,lowerDict(templates),empty(whitelist),empty(implicitend),empty(templates),false,sloppy);
  }
  
  parseString(Original(original,len),tree,pos,opts);
  if (pos < len && !sloppy) {
    throw(InputError("Unexpectedly reached end at "+pos+" before actual end of string."));
  }
  return tree;
}

Dict<String,a> lowerDict(Dict<String,a> indict) {
  outdict = Dict::new(numBuckets(indict),strHash);
  for entry in entries(indict) {
    add(outdict,toLower(entry.fst),entry.snd);
  }
  return outdict;
}

// go along collecting until we get to a tag start
// then parse the tag and recursively call on that tag
// or if it's an end tag, check it matches
// or check it's in implicitend
// return if it's a matching end tag
// if end of string reached, quit
// throw exceptions if something goes wrong
Void parseString(Original original, ElementTree tree, var Int pos, ConvertOpts opts) {
  //  tschar = compile("[A-Za-z_]");
  len = original.len;
  str = "";
  while (pos < len) {
    skip = offsetFirstOccurs('<',original.str,pos);
    if (skip > 0) {
      str += unsafeSubstr(original.str,pos,skip);
      pos += skip;
    }
    if (pos < len) { // c=='<' if we've not reached the end of the string
      if (pos+1 < len) {
	fchar = unsafeIndex(original.str,pos+1);
	if (fchar == '/') {
	  if (parseEndTag(original,tree.name,pos,opts)) {
	    if (str != "") {
	      pushData(tree,entityToLiteral(str));
	    }
	    return;
	  }
	} else if (isAlpha(fchar) || fchar == '_') {
	  if (str != "") {
	    pushData(tree,entityToLiteral(str));
	    str = "";
	  }
	  case analyseStartTag(original,tree.name,pos,opts) of {
	    BlackListed -> skipTag(original,pos,opts);
	    | Empty(newel) -> pushElement(tree,newel); pos--;
	    | ImplicitCloser -> pos--; return; // don't move on by pos in this case
	    | NormalOpen(newel) -> pushElement(tree,newel);
	    parseString(original,newel,pos,opts);
	    | TemplateFn(fn) -> pushGenerator(tree,@fn);
	  }
	} else if (fchar == '!') {
	  if (pos+3 < len) {
	    if ((unsafeIndex(original.str,pos+2) == '-') && (unsafeIndex(original.str,pos+3) == '-')) {
	      pos += 4;
	      skipComment(original,pos,opts);
	    } else {
	      skipTag(original,pos,opts);
	    }
	  } else {
	    if (opts.sloppy) {
	      return;
	    }
	    throw(UnexpectedEnd(getLP(original,pos+1)));
	  }
	  //	} else if (quickMatchWith(tschar,String(fchar))) {
	} else {
	  // literal character
	  str += "<";
	}
      } else {
	// literal character
	str += "<";
      }
    }
    pos++;
  }
  if (str != "") {
    pushData(tree,entityToLiteral(str)); //only happens on root of stack
  }
}

// find out what sort of end tag this is.
// if it matches the current element, return.
// if it matches an implicit end for the current element, RESET pos
// and return
// otherwise exception.
Bool parseEndTag(Original original, String currentname, var Int pos, ConvertOpts opts) {
  // pos currently points at the '<'
  ipos = pos+2; // now points just after </
  len = original.len;
  /*  // don't need to check this, call site already has!
  if (ipos >= len) {
    throw(UnexpectedEnd(getLP(original,ipos)));
  } else if (unsafeIndex(original.str,ipos) != '/') {
    throw(ExpectedChar('/',getLP(original,ipos)));
  }
  ipos++; // now points just after </ */ 
  tagname = getTagName(original,ipos,'>',opts);
  if (tagname == "") {
    if (opts.sloppy) {
      return false; // pos is possibly somewhere reasonably sensible now
    }
    throw(UnexpectedChar(unsafeIndex(original.str,ipos),getLP(original,ipos)));
  } 
  while(isSpace(unsafeIndex(original.str,ipos))) {
    ipos++;
    if (ipos >= len) {
      if (opts.sloppy) {
	return true; // well, it probably meant to close it
      }
      throw(UnexpectedEnd(getLP(original,ipos)));
    }
  }
  if (unsafeIndex(original.str,ipos) != '>') {
    if (!opts.sloppy) {
      throw(UnexpectedChar(unsafeIndex(original.str,ipos),getLP(original,ipos)));
    }
  }
  //  ipos++; // ipos now points just past the end of the close tag.
  if (tagname == currentname) {
    // simplest case, tag is closing the current element
    pos = ipos; // update pos
    return true;
  } else {
    if (!opts.ieempty) {
      iclosers = lookup(opts.implicitend,currentname);
      case iclosers of {
	nothing -> ;
	| just(icloser) -> ctag = "/"+tagname;
	if (elem(ctag,icloser)) {
	  // implicit closing. Don't update pos from ipos
	  pos--; // but do decrement it
	  return true;
	}
      }
    }
    if (opts.wlempty || exists(opts.whitelist,tagname) || exists(opts.whitelist,"*")) {
      if (opts.sloppy) {
	pos = ipos; // we're probably correcting for a previous error here
	return false;
      }
      throw(InputError("Unexpected closing tag "+tagname+" at "+getLP(original,pos)));
    } else {
      // it's a blacklisted tag, so assume we skipped an earlier start tag.
      pos = ipos; // we do update pos here.
      return false; // but don't drop a level
    }
  }
}

// Perhaps there needs to be a better way to deal with namespaces here?
String getTagName(Original original, var Int ipos, Char closer= '>', ConvertOpts opts) {
  tagname = createString(10);
  len = original.len;
  // closer defaults to > as a safe character, but when it's set to = above
  // still need to check for > for shortattrs.
  str = original.str;
  c = unsafeIndex(str,ipos);
  if (!(isAlpha(c) || c == '_' || c == ':')) {
    if (opts.sloppy) {
      return "";
    }
    throw(UnexpectedChar(c,getLP(original,ipos)));
  }
  while (ipos < len) {
    if (isAlnum(c) || c == '.' || c == '-' || c == '_' || c == ':') {
      tagname += c;
      ipos++;
      c = unsafeIndex(str,ipos); // worst case sets 'c' == '\0', so safe
    } else if (c == '>' || isSpace(c) || c == closer || c == '/') {
      if (opts.casesen) {
	return tagname;
      } else {
	return toLower(tagname);
      }
    } else {
      if (opts.sloppy) {
	return "";
      }
      throw(UnexpectedChar(c,getLP(original,ipos)));
    }
  }
  // tag/attr names can't be at the end of the file!
  if (opts.sloppy) {
    ipos--;
    return "";
  }
  throw(UnexpectedEnd(getLP(original,ipos)));
}

StartTagType analyseStartTag(Original original, String currentname, var Int pos, ConvertOpts opts) {
  // pos currently points at the '<' 
  ipos = pos+1; // in case we get an implicit closer or a blacklist
  tagname = getTagName(original,ipos,'>',opts);
  if (tagname == "") {
    if (opts.sloppy) {
      return BlackListed; // mangled tag
    }
    throw(UnexpectedChar(unsafeIndex(original.str,ipos),getLP(original,ipos)));
  }
  if (!opts.wlempty && !exists(opts.whitelist,tagname) && !exists(opts.whitelist,"*")) {
    if (opts.tmempty || !exists(opts.templates,tagname)) {
      return BlackListed;
    }
  }
  if (!opts.ieempty) {
    case lookup(opts.implicitend,currentname) of {
      nothing -> ;
      | just(enders) -> if (elem(tagname,enders)) {
	// implicit ending of current element, so need to end it before we start a new one
	return ImplicitCloser;
      }
    }
  }
  if (!opts.tmempty) {
    case lookup(opts.templates,tagname) of {
      nothing -> ;
      | just(fn) -> tfn = copy(fn);
      newel = newElement(tagname);
      if(parseAttributes(original,ipos,newel,opts)) {
	ipos++;
	skipToTagEnd(original,ipos,opts);
      }
      pos = ipos;
      return TemplateFn(tfn@(entries(newel.attributes)));
    }
  }
  // now ipos is just after the <elname
  if (elem(tagname,opts.emptyels)) {
    newel = newElement(tagname);
    rv = Empty(newel);
  } else {
    newel = newElement(tagname);
    rv = NormalOpen(newel);
  }
  
  if (parseAttributes(original,ipos,newel,opts)) {
    case rv of {
      Empty(n) -> ipos++; // skip it, we know
      // and now skip any whitespace after the '/'
      skipToTagEnd(original,ipos,opts);
      | NormalOpen(n) -> ipos++;  // if it's an actual '/' closing, could
	  // be a "happens to be empty" element in XML.
      skipToTagEnd(original,ipos,opts);
      rv = Empty(n);
      | _ -> if (opts.sloppy) {
	pos = ipos+1; // might be in about the right place?
	return Empty(n); // treat as empty even though it shouldn't be?
      }
      throw(InputError("Unexpected closing of non-empty element."));
    }
  }
  //  ipos++; // ipos now points just past the end of the close tag.
  pos = ipos+1;
  return rv;
}

Void skipToTagEnd(Original original, var Int ipos, ConvertOpts opts) {
  len = original.len;
  if (ipos >= len) {
    if (opts.sloppy) {
      return; 
    }
    throw(UnexpectedEnd(getLP(original,ipos)));
  }
  while(isSpace(unsafeIndex(original.str,ipos))) {
    ipos++;
    if (ipos >= len) {
      if (opts.sloppy) {
	return; 
      }
      throw(UnexpectedEnd(getLP(original,ipos)));
    }
  }
  if (unsafeIndex(original.str,ipos) != '>') { // if parseAtt false already know this
    if (!opts.sloppy) {
      throw(UnexpectedChar(unsafeIndex(original.str,ipos),getLP(original,ipos)));
    }
  }
}

// true for XML empty closer, false for end of tag, to optimise analyseS.T.
Bool parseAttributes(Original original, var Int ipos, ElementTree el, ConvertOpts opts) {
  len = original.len;
  while (ipos < len) {
    c = unsafeIndex(original.str,ipos);
    if (c == '>') {
      return false;
    } else if (c == '/') {
      return true;
    } else {
      // get through any whitespace separating attribs
      if (!isSpace(c)) {
	parseAttribute(original,ipos,el,opts);
      }
      ipos++;
    }
  }
  if (opts.sloppy) {
    ipos = len-3; // back off a bit to try again later
    return false;
  }
  throw(UnexpectedEnd(getLP(original,ipos)));
}

Void parseAttribute(Original original, var Int ipos, ElementTree el, ConvertOpts opts) {
  // ipos is just after the whitespace
  attrname = getTagName(original,ipos,'=',opts);
  // ipos is on '=', in theory
  c = unsafeIndex(original.str,ipos);
  if (isSpace(c)) {
    // unless it's a minimised attribute (which can be the end of the tag, of course)
    attrval = attrname; //actually, name = val, here.
  } else if (c == '>') {
    attrval = attrname; //actually, name = val, here.
    ipos--;
    /*  } else if (c != '=') {
	throw(UnexpectedChar(c,getLP(original,ipos)));    */
    // it must be '=' because of getTagName
  } else {
    ipos++; // now on start of attribute value, skip the '='
    len = original.len;
    if (ipos >= len) {
      if (opts.sloppy) {
	return;
      }
      throw(UnexpectedEnd(getLP(original,ipos)));
    }
    c = unsafeIndex(original.str,ipos);
    if (c == '"') {
      ipos++;
      attrval = getAttVal(original,ipos,'"',opts);
    } else if (c == '\'') {
      ipos++;
      attrval = getAttVal(original,ipos,'\'',opts);
    } else {
      attrval = getAttVal(original,ipos,Char(0),opts);
    }
  }

  if (!opts.tmempty && exists(opts.templates,el.name)) {
    setAttribute(el,attrname,entityToLiteral(attrval));
    return;
  } 
  if (!opts.wlempty) {
    getallowed = lookup(opts.whitelist,el.name);
    case getallowed of {
      just(allowed) -> ;
      | nothing -> allowed = deref(lookup(opts.whitelist,"*")); // let it throw if this assumption's wrong
    }

    if (!elem(attrname,allowed) && !elem("*",allowed)) {
      return;
    }
  } 
  setAttribute(el,attrname,entityToLiteral(attrval));
}

String getAttVal(Original original, var Int ipos, Char ender, ConvertOpts opts) {
  len = original.len;
  if (ipos >= len) {
    if (opts.sloppy) {
      ipos = len-2;
      return "";
    }
    throw(UnexpectedEnd(getLP(original,ipos)));
  }
  attrval = createString(40);
  if (ender == Char(0)) {
    while (ipos < len && (isAlnum(unsafeIndex(original.str,ipos)))) {
      attrval += String(unsafeIndex(original.str,ipos));
      ipos++;
    }
  } else {
    sz = offsetFirstOccurs(ender,original.str,ipos);
    if (sz > 0) {
      attrval = unsafeSubstr(original.str,ipos,sz);
    }
    ipos+=sz;
  }
  if (ipos >= len) {
    if (opts.sloppy) {
      ipos = len-2;
      return "";
    }
    throw(UnexpectedEnd(getLP(original,ipos)));
  }
  if (ender == Char(0)) {
    c = unsafeIndex(original.str,ipos);
    if (!isSpace(c) && c != '>') {
      if (!opts.sloppy) {
	throw(UnexpectedChar(c,getLP(original,ipos)));
      }
    }
    ipos--; // we reincrement later
  } 
  return attrval;
}

Void skipTag(Original original, var Int pos, ConvertOpts opts) {
  // currently at start of tag to skip, need to move to just after end of this tag.
  sq = false;
  dq = false;
  ended = false;
  len = original.len;
  while (pos < len && !ended) {
    c = unsafeIndex(original.str,pos);
    if (sq) {
      if (c == '\'') {
	sq = false;
      }
    } else if (dq) {
      if (c == '"') {
	dq = false;
      }
    } else {
      if (c == '>') {
	ended = true;
      }
    }
    if (!ended) {
      pos++;
    }
  }
  if (!ended) {
    if (!opts.sloppy) {
      throw(UnexpectedEnd(getLP(original,pos)));
    }
  }
  // now pos points just after end tag
}

Void skipComment(Original original, var Int pos, ConvertOpts opts) {
  cdash1 = false;
  cdash2 = false;
  len = original.len;
  while (pos < len) {
    if (cdash2) {
      if (unsafeIndex(original.str,pos) == '>') {
	return;
      }
    } else if (!cdash1) {
      if (unsafeIndex(original.str,pos) == '-') {
	cdash1 = true;
      }
    } else {
      if (unsafeIndex(original.str,pos) == '-') {
	cdash2 = true;
      } else {
	cdash1 = false;
      }
    }
    pos++;
  }
  if (!opts.sloppy) {
    throw(UnexpectedEnd(getLP(original,pos)));
  }
}

String getLP(Original original, Int pos) {
  line = 1;
  col = 1;
  for i in [0..pos-1] {
    if (unsafeIndex(original.str,i) == '\n') {
      line++;
      col = 1;
    } else if (unsafeIndex(original.str,i) == '\r' && (i+1 == pos || unsafeIndex(original.str,i) != '\n')) {
      line++;
      col = 1;
    } else {
      col++;
    }
  }
  return "Line "+line+", Column "+col;
}