$module "refal.plus.XML";

$use Access Convert Stream StdIO;

$func? IsBlank t.term = ;
IsBlank \{ ' '; '\n'; '\r'; '\t'; };

$func? IsBlankOrDelim t.delim t.term = ;
IsBlankOrDelim t.delim t.term, t.term : \{ ' '; '\n'; '\r'; '\t'; t.delim; };

$func GetUntilDelim s.stream t.delim = e.expr; // no e.delim at the end
GetUntilDelim s.stream t.delim = 
  () $iter {
    <Get_While s.stream &IsBlank> :: e, {
      <Scanc s.stream t.delim> : v = (e.expr) Stop;
      <Get_Until s.stream &IsBlankOrDelim t.delim> : v.head = (e.expr ' ' v.head);
      (e.expr) Stop;
    };
  } :: (e.expr) e.isStop, e.isStop : v =
  { e.expr : ' ' e.head = e.head; e.expr; };

$func? GetXMLFormat s.stream = t.comment;
GetXMLFormat s.stream, <Scanc s.stream '?'> : v = ((XML_FORMAT) <Middle 0 2 <Get_Delims s.stream '?>'>>);

$func? GetComment s.stream = t.comment;
GetComment s.stream, <Scans s.stream '!--'> : v = ((COMMENT) <Middle 0 3 <Get_Delims s.stream '-->'>>);

$func? GetCDATA s.stream = t.cdata;
GetCDATA s.stream, <Scans s.stream '![CDATA['> : v = ((CDATA) <Middle 0 3 <Get_Delims s.stream ']]>'>>);

$func FindTag s.stream = e.text (v.tag);
FindTag s.stream = <GetUntilDelim s.stream '<'> :: e.text, {
  \{ <GetXMLFormat s.stream>; <GetComment s.stream>; <GetCDATA s.stream>; } :: e.text1 = e.text e.text1 <FindTag s.stream>;
  e.text ('<' <GetUntilDelim s.stream '>'> '>');
};

$func SplitAttrs e.text = e.attrs;
SplitAttrs e.attrs,
  () (e.attrs) $iter {
    e.attrs : e.key '=' '"' e.value '"' e.tail =
      { e.tail : ' ' e.tail1 = e.tail1; e.tail; } :: e.tail,      
      (e.keyvalues (<ToWord e.key> <ToWord e.value>)) (e.tail);
  } :: (e.keyvalues) (e.attrs), e.attrs : /* empty */ =
  e.keyvalues;

$func SplitName e.text = e.name (e.attrs);
SplitName {
  e.name ' ' e.attrs = e.name (<SplitAttrs e.attrs>); 
  e.name = e.name (); 
};

$func ReadTag s.stream v.tag = t;
ReadTag s.stream v.tag, v.tag : {
  '<' e.name '/>' =
    <SplitName e.name> :: e.name (e.attrs), 
    (<ToWord e.name> ((ATTRIBUTES) e.attrs));
  '<' e.name '>' =
    <SplitName e.name> :: e.name (e.attrs),
    <FindTag s.stream> $iter e.text <ReadTag s.stream v.tag> <FindTag s.stream> :: e.text (v.tag),
    v.tag : '</' e.name '>',
    (<ToWord e.name> ((ATTRIBUTES) e.attrs) e.text);
};

$public $func Read s.stream = e.text_then_XML_tag;
Read s.stream = <FindTag s.stream> : e.text (v.tag), e.text <ReadTag s.stream v.tag>;

$public $func? GetAttribute t.tag s.attrName = s.attrValue;
GetAttribute (s (t e (s.attrName s.attrValue) e) e) s.attrName = s.attrValue;

$public $func? GetTag t.tag t.innerTagName = t.innerTag;
GetTag (s t e t.innerTag e) t.innerTagName, t.innerTag : (t.innerTagName e) = t.innerTag;

$public $func? GetValue t.tag = e.value;
GetValue (s t e.value) = e.value;

$public $func? ReadXML e.fileName = e.xml;
ReadXML e.fileName =
  $trap <File_Open e.fileName> :: s.stream, {
    <XML.Read s.stream> :: e.xml = <File_Close s.stream>, e.xml;
    = <File_Close s.stream>, $fail;
  } $with $fail;

$func Main = e;
Main =
  <WriteLn <Read <Expr_Open '<Z>as<C/><B>b<!--<Z></Z>--></B><C>c</C></Z>'>>>;